vhdl2008: allow out port in sensitivity lists.

Fix #326

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;