vhdl08: allow unaffected in sequential signal assignments.

10 files changed, 106 insertions, 30 deletions

diff --git a/src/vhdl/canon.adb b/src/vhdl/canon.adb
index 916cb2b84..8a1ec3736 100644
--- a/src/vhdl/canon.adb
+++ b/src/vhdl/canon.adb
@@ -1436,7 +1436,7 @@ package body Canon is
       Stmt : Iir;
       Sensitivity_List : Iir_List;
    begin
-      if Waveform_Chain = Null_Iir then
+      if Get_Kind (Waveform_Chain) = Iir_Kind_Unaffected_Waveform then
          --  LRM 9.5.1 Conditionnal Signal Assignment
          --  If the waveform is of the form:
          --    UNAFFECTED
diff --git a/src/vhdl/disp_vhdl.adb b/src/vhdl/disp_vhdl.adb
index b92433fff..211aeb9db 100644
--- a/src/vhdl/disp_vhdl.adb
+++ b/src/vhdl/disp_vhdl.adb
@@ -1783,6 +1783,9 @@ package body Disp_Vhdl is
       if Chain = Null_Iir then
          Put ("null after {disconnection_time}");
          return;
+      elsif Get_Kind (Chain) = Iir_Kind_Unaffected_Waveform then
+         Put ("unaffected");
+         return;
       end if;
       We := Chain;
       while We /= Null_Iir loop
diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb
index e34c43af7..7119563cc 100644
--- a/src/vhdl/errorout.adb
+++ b/src/vhdl/errorout.adb
@@ -691,6 +691,8 @@ package body Errorout is
             return "null literal";
          when Iir_Kind_Overflow_Literal =>
             return Disp_Node (Get_Literal_Origin (Node));
+         when Iir_Kind_Unaffected_Waveform =>
+            return "unaffected waveform";
          when Iir_Kind_Aggregate =>
             return "aggregate";
          when Iir_Kind_Unit_Declaration =>
diff --git a/src/vhdl/iirs.adb b/src/vhdl/iirs.adb
index d4f92a57a..b14e6175a 100644
--- a/src/vhdl/iirs.adb
+++ b/src/vhdl/iirs.adb
@@ -262,6 +262,7 @@ package body Iirs is
            | Iir_Kind_Physical_Fp_Literal
            | Iir_Kind_Simple_Aggregate
            | Iir_Kind_Overflow_Literal
+           | Iir_Kind_Unaffected_Waveform
            | Iir_Kind_Waveform_Element
            | Iir_Kind_Conditional_Waveform
            | Iir_Kind_Conditional_Expression
diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads
index 8483ec68d..79356b3cd 100644
--- a/src/vhdl/iirs.ads
+++ b/src/vhdl/iirs.ads
@@ -407,6 +407,9 @@ package Iirs is
    --
    --   Get/Set_Expr_Staticness (State1)
 
+   -- Iir_Kind_Unaffected_Waveform (Short)
+   --  The 'unaffected' reserved word when it appears in the sources.
+
    -------------
    --  Tuples --
    -------------
@@ -3969,6 +3972,8 @@ package Iirs is
       Iir_Kind_Simple_Aggregate,
       Iir_Kind_Overflow_Literal,
 
+      Iir_Kind_Unaffected_Waveform,
+
    -- Tuple,
       Iir_Kind_Waveform_Element,
       Iir_Kind_Conditional_Waveform,
diff --git a/src/vhdl/nodes_meta.adb b/src/vhdl/nodes_meta.adb
index 6669fed53..6eeae3877 100644
--- a/src/vhdl/nodes_meta.adb
+++ b/src/vhdl/nodes_meta.adb
@@ -1034,6 +1034,8 @@ package body Nodes_Meta is
             return "simple_aggregate";
          when Iir_Kind_Overflow_Literal =>
             return "overflow_literal";
+         when Iir_Kind_Unaffected_Waveform =>
+            return "unaffected_waveform";
          when Iir_Kind_Waveform_Element =>
             return "waveform_element";
          when Iir_Kind_Conditional_Waveform =>
@@ -2294,6 +2296,7 @@ package body Nodes_Meta is
       Field_Expr_Staticness,
       Field_Literal_Origin,
       Field_Type,
+      --  Iir_Kind_Unaffected_Waveform
       --  Iir_Kind_Waveform_Element
       Field_We_Value,
       Field_Time,
@@ -4336,6 +4339,7 @@ package body Nodes_Meta is
       Iir_Kind_Physical_Fp_Literal => 79,
       Iir_Kind_Simple_Aggregate => 84,
       Iir_Kind_Overflow_Literal => 87,
+      Iir_Kind_Unaffected_Waveform => 87,
       Iir_Kind_Waveform_Element => 90,
       Iir_Kind_Conditional_Waveform => 93,
       Iir_Kind_Conditional_Expression => 96,
diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb
index fc9dae4db..99c459027 100644
--- a/src/vhdl/parse.adb
+++ b/src/vhdl/parse.adb
@@ -5371,11 +5371,11 @@ package body Parse is
    --  precond : next token
    --  postcond: next token.
    --
-   --  [ §8.4 ]
+   --  [ 8.4 ]
    --  waveform ::= waveform_element { , waveform_element }
    --             | UNAFFECTED
    --
-   --  [ §8.4.1 ]
+   --  [ 8.4.1 ]
    --  waveform_element ::= VALUE_expression [ AFTER TIME_expression ]
    --                     | NULL [ AFTER TIME_expression ]
    function Parse_Waveform return Iir_Waveform_Element
@@ -5387,31 +5387,43 @@ package body Parse is
          if Flags.Vhdl_Std = Vhdl_87 then
             Error_Msg_Parse ("'unaffected' is not allowed in vhdl87");
          end if;
+
+         Res := Create_Iir (Iir_Kind_Unaffected_Waveform);
+         Set_Location (Res);
+
+         --  Skip 'unaffected'.
          Scan;
-         return Null_Iir;
       else
          Sub_Chain_Init (Res, Last_We);
          loop
             We := Create_Iir (Iir_Kind_Waveform_Element);
             Sub_Chain_Append (Res, Last_We, We);
             Set_Location (We);
+
             --  Note: NULL is handled as a null_literal.
             Set_We_Value (We, Parse_Expression);
+
             if Current_Token = Tok_After then
+               --  Skip 'after'.
                Scan;
+
                Set_Time (We, Parse_Expression);
             end if;
+
             exit when Current_Token /= Tok_Comma;
+
+            --  Skip ','.
             Scan;
          end loop;
-         return Res;
       end if;
+
+      return Res;
    end Parse_Waveform;
 
    --  precond : next token
    --  postcond: next token
    --
-   --  [ §8.4 ]
+   --  [ 8.4 ]
    --  delay_mechanism ::= TRANSPORT
    --                    | [ REJECT TIME_expression ] INERTIAL
    procedure Parse_Delay_Mechanism (Assign: Iir) is
@@ -5542,7 +5554,6 @@ package body Parse is
       Parse_Options (Res);
 
       Wf := Parse_Conditional_Waveforms;
-      --  WF can be Null_Iir if the waveform is simply 'unaffected'.
       if Wf /= Null_Iir
         and then Get_Kind (Wf) = Iir_Kind_Conditional_Waveform
       then
@@ -5929,9 +5940,12 @@ package body Parse is
       --  LRM 8.4 Signal assignment statement
       --  It is an error is the reserved word UNAFFECTED appears as a
       --  waveform in a (sequential) signal assignment statement.
-      if Wave_Chain = Null_Iir then
-         Error_Msg_Parse
-           ("'unaffected' is not allowed in a sequential statement");
+      if Get_Kind (Wave_Chain) = Iir_Kind_Unaffected_Waveform then
+         if Flags.Vhdl_Std < Vhdl_08 then
+            Error_Msg_Parse
+              ("'unaffected' is not allowed in a sequential statement");
+         end if;
+         Set_Waveform_Chain (Stmt, Wave_Chain);
       elsif Get_Kind (Wave_Chain) = Iir_Kind_Conditional_Waveform then
          if Flags.Vhdl_Std < Vhdl_08 then
             Error_Msg_Parse
diff --git a/src/vhdl/sem_stmts.adb b/src/vhdl/sem_stmts.adb
index f26e432c9..d352aac0a 100644
--- a/src/vhdl/sem_stmts.adb
+++ b/src/vhdl/sem_stmts.adb
@@ -464,7 +464,7 @@ package body Sem_Stmts is
       We: Iir_Waveform_Element;
       Time, Last_Time : Iir_Int64;
    begin
-      if Waveform_Chain = Null_Iir then
+      if Get_Kind (Waveform_Chain) = Iir_Kind_Unaffected_Waveform then
          --  Unaffected.
          return;
       end if;
@@ -584,7 +584,7 @@ package body Sem_Stmts is
       Expr : Iir;
       Targ_Type : Iir;
    begin
-      if Waveform_Chain = Null_Iir then
+      if Get_Kind (Waveform_Chain) = Iir_Kind_Unaffected_Waveform then
          return;
       end if;
 
@@ -722,9 +722,12 @@ package body Sem_Stmts is
                   El := Get_Selected_Waveform_Chain (Stmt);
                   while El /= Null_Iir loop
                      Wf_Chain := Get_Associated_Chain (El);
-                     Sem_Waveform_Chain (Wf_Chain, Target_Type);
-                     if Done then
-                        Sem_Check_Waveform_Chain (Stmt, Wf_Chain);
+                     if Is_Valid (Wf_Chain) then
+                        --  The first choice of a list.
+                        Sem_Waveform_Chain (Wf_Chain, Target_Type);
+                        if Done then
+                           Sem_Check_Waveform_Chain (Stmt, Wf_Chain);
+                        end if;
                      end if;
                      El := Get_Chain (El);
                   end loop;
diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb
index 2311d5d8b..3e7fcb2a4 100644
--- a/src/vhdl/translate/trans-chap8.adb
+++ b/src/vhdl/translate/trans-chap8.adb
@@ -4203,6 +4203,13 @@ package body Trans.Chap8 is
       Targ : Mnode;
       Drv : Mnode;
    begin
+      if Is_Valid (Wf_Chain)
+        and then Get_Kind (Wf_Chain) = Iir_Kind_Unaffected_Waveform
+      then
+         --  Unaffected, like a null statement.
+         return;
+      end if;
+
       if Is_Reject_Signal_Assignment (Stmt)
         or else not Is_Simple_Waveform (Wf_Chain)
       then
diff --git a/src/vhdl/translate/trans_analyzes.adb b/src/vhdl/translate/trans_analyzes.adb
index 93701819e..357527882 100644
--- a/src/vhdl/translate/trans_analyzes.adb
+++ b/src/vhdl/translate/trans_analyzes.adb
@@ -26,6 +26,7 @@ package body Trans_Analyzes is
    Driver_List : Iir_List;
 
    Has_After : Boolean;
+
    function Extract_Driver_Target (Target : Iir) return Walk_Status
    is
       Base : Iir;
@@ -48,15 +49,15 @@ package body Trans_Analyzes is
       return Walk_Continue;
    end Extract_Driver_Target;
 
+   --  Set Has_After to True iff WF requires a non-direct driver.
    procedure Extract_Has_After (Wf : Iir) is
    begin
-      if Wf /= Null_Iir
-        and then Get_Chain (Wf) = Null_Iir
-        and then Get_Time (Wf) = Null_Iir
-        and then Get_Kind (Get_We_Value (Wf)) /= Iir_Kind_Null_Literal
+      --  Disconnect, or time expression.
+      if Wf = Null_Iir
+        or else Get_Chain (Wf) /= Null_Iir
+        or else Get_Time (Wf) /= Null_Iir
+        or else Get_Kind (Get_We_Value (Wf)) = Iir_Kind_Null_Literal
       then
-         Has_After := False;
-      else
          Has_After := True;
       end if;
    end Extract_Has_After;
@@ -66,34 +67,70 @@ package body Trans_Analyzes is
       Status : Walk_Status;
       pragma Unreferenced (Status);
    begin
+      --  Clear Has_After.  It will be set to True if a signal assignment
+      --  has an delay expression or a null transaction.
+      --  (It is cleared for any statement, just to factorize code).
+      Has_After := False;
+
       case Iir_Kinds_Sequential_Statement (Get_Kind (Stmt)) is
          when Iir_Kind_Simple_Signal_Assignment_Statement =>
-            Extract_Has_After (Get_Waveform_Chain (Stmt));
-            Status := Walk_Assignment_Target
-              (Get_Target (Stmt), Extract_Driver_Target'Access);
+            declare
+               Wf : constant Iir := Get_Waveform_Chain (Stmt);
+            begin
+               if Is_Null (Wf)
+                 or else Get_Kind (Wf) /= Iir_Kind_Unaffected_Waveform
+               then
+                  --  Not unaffected or implicit disconnect.
+                  Extract_Has_After (Wf);
+                  Status := Walk_Assignment_Target
+                    (Get_Target (Stmt), Extract_Driver_Target'Access);
+               end if;
+            end;
          when Iir_Kind_Conditional_Signal_Assignment_Statement =>
             declare
                Cond_Wf : Iir;
+               Wf : Iir;
+               Has_Drv : Boolean;
             begin
                Cond_Wf := Get_Conditional_Waveform_Chain (Stmt);
+               Has_Drv := False;
                while Cond_Wf /= Null_Iir loop
-                  Extract_Has_After (Get_Waveform_Chain (Cond_Wf));
+                  Wf := Get_Waveform_Chain (Cond_Wf);
+                  if Get_Kind (Wf) /= Iir_Kind_Unaffected_Waveform then
+                     --  Not unaffected
+                     Extract_Has_After (Wf);
+                     Has_Drv := True;
+                  end if;
                   Cond_Wf := Get_Chain (Cond_Wf);
                end loop;
-               Status := Walk_Assignment_Target
-                 (Get_Target (Stmt), Extract_Driver_Target'Access);
+               if Has_Drv then
+                  Status := Walk_Assignment_Target
+                    (Get_Target (Stmt), Extract_Driver_Target'Access);
+               end if;
             end;
          when Iir_Kind_Selected_Waveform_Assignment_Statement =>
             declare
                Swf : Iir;
+               Wf : Iir;
+               Has_Drv : Boolean;
             begin
                Swf := Get_Selected_Waveform_Chain (Stmt);
+               Has_Drv := False;
                while Swf /= Null_Iir loop
-                  Extract_Has_After (Get_Associated_Chain (Swf));
+                  if not Get_Same_Alternative_Flag (Swf) then
+                     Wf := Get_Associated_Chain (Swf);
+                     if Get_Kind (Wf) /= Iir_Kind_Unaffected_Waveform then
+                        --  Not unaffected
+                        Extract_Has_After (Wf);
+                        Has_Drv := True;
+                     end if;
+                  end if;
                   Swf := Get_Chain (Swf);
                end loop;
-               Status := Walk_Assignment_Target
-                 (Get_Target (Stmt), Extract_Driver_Target'Access);
+               if Has_Drv then
+                  Status := Walk_Assignment_Target
+                    (Get_Target (Stmt), Extract_Driver_Target'Access);
+               end if;
             end;
          when Iir_Kind_Procedure_Call_Statement =>
             declare