diff options
-rw-r--r-- | src/vhdl/iirs_utils.adb | 12 | ||||
-rw-r--r-- | src/vhdl/iirs_utils.ads | 3 | ||||
-rw-r--r-- | src/vhdl/sem_stmts.adb | 26 |
3 files changed, 35 insertions, 6 deletions
diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb index 1304889bf..c8be11e75 100644 --- a/src/vhdl/iirs_utils.adb +++ b/src/vhdl/iirs_utils.adb @@ -544,6 +544,18 @@ package body Iirs_Utils is return Null_Iir; end Find_First_Association_For_Interface; + function Is_Parameter (Inter : Iir) return Boolean is + begin + case Get_Kind (Get_Parent (Inter)) is + when Iir_Kinds_Subprogram_Declaration + | Iir_Kinds_Interface_Subprogram_Declaration => + return True; + when others => + -- Port + return False; + end case; + end Is_Parameter; + function Find_Name_In_List (List: Iir_List; Lit: Name_Id) return Iir is El: Iir; Ident: Name_Id; diff --git a/src/vhdl/iirs_utils.ads b/src/vhdl/iirs_utils.ads index fbe4c1127..e5b6b6842 100644 --- a/src/vhdl/iirs_utils.ads +++ b/src/vhdl/iirs_utils.ads @@ -100,6 +100,9 @@ package Iirs_Utils is function Find_First_Association_For_Interface (Assoc_Chain : Iir; Inter_Chain : Iir; Inter : Iir) return Iir; + -- Return True iff interface INTER is a (subprogram) parameter. + function Is_Parameter (Inter : Iir) return Boolean; + -- Duplicate enumeration literal LIT. function Copy_Enumeration_Literal (Lit : Iir) return Iir; diff --git a/src/vhdl/sem_stmts.adb b/src/vhdl/sem_stmts.adb index 2db4df804..b8f85e5fc 100644 --- a/src/vhdl/sem_stmts.adb +++ b/src/vhdl/sem_stmts.adb @@ -223,7 +223,7 @@ package body Sem_Stmts is (Stmt : Iir; Target : Iir; Staticness : Iir_Staticness); -- Semantic associed with signal mode. - -- See §4.3.3 + -- See LRM93 4.3.3 (or LRM08 6.5.2) type Boolean_Array_Of_Iir_Mode is array (Iir_Mode) of Boolean; Iir_Mode_Readable : constant Boolean_Array_Of_Iir_Mode := (Iir_Unknown_Mode => False, @@ -240,6 +240,22 @@ package body Sem_Stmts is Iir_Buffer_Mode => True, Iir_Linkage_Mode => False); + -- Return True iff signal interface INTER is readable. + function Is_Interface_Signal_Readable (Inter : Iir) return Boolean + is + pragma Assert (Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration); + Mode : constant Iir_Mode := Get_Mode (Inter); + begin + if Mode = Iir_Out_Mode and then Flags.Vhdl_Std >= Vhdl_08 then + -- LRM08 6.5.2 Interface object declarations + -- OUT. The value of the inerface object is allowed [...] and + -- provided it is not a signal parameter, read. + return not Is_Parameter (Inter); + else + return Iir_Mode_Readable (Mode); + end if; + end Is_Interface_Signal_Readable; + procedure Check_Aggregate_Target (Stmt : Iir; Target : Iir; Nbr : in out Natural) is @@ -336,8 +352,7 @@ package body Sem_Stmts is -- associated with the formal. -- GHDL: parent of target cannot be a function. if Targ_Obj_Kind = Iir_Kind_Interface_Signal_Declaration - and then - Get_Kind (Get_Parent (Target_Prefix)) = Iir_Kind_Procedure_Declaration + and then Is_Parameter (Target_Prefix) then Guarded_Target := Unknown; else @@ -1133,7 +1148,7 @@ package body Sem_Stmts is | Iir_Kinds_Signal_Attribute => null; when Iir_Kind_Interface_Signal_Declaration => - if not Iir_Mode_Readable (Get_Mode (Prefix)) then + if not Is_Interface_Signal_Readable (Prefix) then Error_Msg_Sem (+El, "%n of mode out can't be in a sensivity list", +Res); @@ -2140,8 +2155,7 @@ package body Sem_Stmts is -- Within a subprogram. if Get_Kind (Sig_Object) = Iir_Kind_Signal_Declaration - or else (Get_Kind (Get_Parent (Sig_Object)) - /= Iir_Kind_Procedure_Declaration) + or else not Is_Parameter (Sig_Object) then Error_Msg_Sem (+Stmt, "%n is not a formal parameter", +Sig_Object); end if; |