vhdl: handle selected waveform assignment

3 files changed, 75 insertions, 51 deletions

diff --git a/src/vhdl/vhdl-canon.adb b/src/vhdl/vhdl-canon.adb
index 906a4720b..6859cdecc 100644
--- a/src/vhdl/vhdl-canon.adb
+++ b/src/vhdl/vhdl-canon.adb
@@ -515,6 +515,9 @@ package body Vhdl.Canon is
          when Iir_Kind_Conditional_Signal_Assignment_Statement =>
             Canon_Extract_Sensitivity_Conditional_Signal_Assignment
               (Stmt, List);
+         when Iir_Kind_Selected_Waveform_Assignment_Statement =>
+            Canon_Extract_Sensitivity_Selected_Signal_Assignment
+              (Stmt, List);
          when Iir_Kind_If_Statement =>
             --  LRM08 11.3
             --  * For each if statement, apply the rule of 10.2 to the
@@ -590,8 +593,7 @@ package body Vhdl.Canon is
             --    construct the union of the resulting sets.
             Canon_Extract_Sensitivity_Procedure_Call
               (Get_Procedure_Call (Stmt), List);
-         when Iir_Kind_Selected_Waveform_Assignment_Statement
-           | Iir_Kind_Signal_Force_Assignment_Statement
+         when Iir_Kind_Signal_Force_Assignment_Statement
            | Iir_Kind_Signal_Release_Assignment_Statement
            | Iir_Kind_Break_Statement
            | Iir_Kind_Wait_Statement
diff --git a/src/vhdl/vhdl-parse.adb b/src/vhdl/vhdl-parse.adb
index b61e6ab49..69e7abd10 100644
--- a/src/vhdl/vhdl-parse.adb
+++ b/src/vhdl/vhdl-parse.adb
@@ -7087,7 +7087,7 @@ package body Vhdl.Parse is
    end Parse_Case_Expression;
 
    --  precond : WITH
-   --  postcond: next token
+   --  postcond: ';'
    --
    --  [ LRM93 9.5.2 ]
    --  selected_signal_assignment ::=
@@ -7098,7 +7098,12 @@ package body Vhdl.Parse is
    --  selected_waveforms ::=
    --      { waveform WHEN choices , }
    --      waveform WHEN choices
-   function Parse_Selected_Signal_Assignment return Iir
+   --
+   --  [ LRM08 10.5.4 ]
+   --  selected_waveform_assignment ::=
+   --     WITH expression SELECT [?]
+   --        target <= [ delay_mechanism ] selected_waveforms ;
+   function Parse_Selected_Signal_Assignment (Kind : Iir_Kind) return Iir
    is
       Res : Iir;
       Assoc : Iir;
@@ -7110,7 +7115,7 @@ package body Vhdl.Parse is
       --  Skip 'with'.
       Scan;
 
-      Res := Create_Iir (Iir_Kind_Concurrent_Selected_Signal_Assignment);
+      Res := Create_Iir (Kind);
       Set_Location (Res);
       Set_Expression (Res, Parse_Case_Expression);
 
@@ -7124,7 +7129,14 @@ package body Vhdl.Parse is
       Set_Target (Res, Target);
       Expect_Scan (Tok_Less_Equal);
 
-      Parse_Options (Res);
+      case Kind is
+         when Iir_Kind_Concurrent_Selected_Signal_Assignment =>
+            Parse_Options (Res);
+         when Iir_Kind_Selected_Waveform_Assignment_Statement =>
+            Parse_Delay_Mechanism (Res);
+         when others =>
+            raise Internal_Error;
+      end case;
 
       Chain_Init (First, Last);
       loop
@@ -7144,8 +7156,6 @@ package body Vhdl.Parse is
       end loop;
       Set_Selected_Waveform_Chain (Res, First);
 
-      Expect_Scan (Tok_Semi_Colon, "';' expected at end of signal assignment");
-
       return Res;
    end Parse_Selected_Signal_Assignment;
 
@@ -8172,6 +8182,9 @@ package body Vhdl.Parse is
                      return First_Stmt;
                   end if;
                end;
+            when Tok_With =>
+               Stmt := Parse_Selected_Signal_Assignment
+                 (Iir_Kind_Selected_Waveform_Assignment_Statement);
 
             when Tok_Return =>
                Stmt := Create_Iir (Iir_Kind_Return_Statement);
@@ -10385,7 +10398,11 @@ package body Vhdl.Parse is
                   Expect_Scan (Tok_Semi_Colon);
                end if;
             when Tok_With =>
-               Stmt := Parse_Selected_Signal_Assignment;
+               Stmt := Parse_Selected_Signal_Assignment
+                 (Iir_Kind_Concurrent_Selected_Signal_Assignment);
+               Expect_Scan (Tok_Semi_Colon,
+                            "';' expected at end of signal assignment");
+
             when Tok_Block =>
                Postponed_Not_Allowed;
                Stmt := Parse_Block_Statement (Label, Loc);
diff --git a/src/vhdl/vhdl-sem_stmts.adb b/src/vhdl/vhdl-sem_stmts.adb
index c5ae646d8..c9f481d3e 100644
--- a/src/vhdl/vhdl-sem_stmts.adb
+++ b/src/vhdl/vhdl-sem_stmts.adb
@@ -41,6 +41,8 @@ package body Vhdl.Sem_Stmts is
    procedure Sem_Sequential_Statements_Internal (First_Stmt : Iir);
 
    procedure Sem_Simultaneous_Statements (First : Iir);
+   procedure Sem_Case_Choices
+     (Choice : Iir; Chain : in out Iir; Loc : Location_Type);
 
    -- Access to the current subprogram or process.
    Current_Subprogram: Iir := Null_Iir;
@@ -688,6 +690,32 @@ package body Vhdl.Sem_Stmts is
       end loop;
    end Sem_Check_Waveform_Chain;
 
+   procedure Sem_Selected_Signal_Assignment_Expression (Stmt : Iir)
+   is
+      Expr: Iir;
+      Chain : Iir;
+   begin
+      --  LRM 9.5  Concurrent Signal Assignment Statements.
+      --  The process statement equivalent to a concurrent signal assignment
+      --  statement [...] is constructed as follows: [...]
+      --
+      --  LRM 9.5.2  Selected Signal Assignment
+      --  The characteristics of the selected expression, the waveforms and
+      --  the choices in the selected assignment statement must be such that
+      --  the case statement in the equivalent statement is a legal
+      --  statement
+
+      --  The choices.
+      Chain := Get_Selected_Waveform_Chain (Stmt);
+      Expr := Sem_Case_Expression (Get_Expression (Stmt));
+      if Expr /= Null_Iir then
+         Check_Read (Expr);
+         Set_Expression (Stmt, Expr);
+         Sem_Case_Choices (Expr, Chain, Get_Location (Stmt));
+         Set_Selected_Waveform_Chain (Stmt, Chain);
+      end if;
+   end Sem_Selected_Signal_Assignment_Expression;
+
    procedure Sem_Guard (Stmt: Iir)
    is
       Guard: Iir;
@@ -782,7 +810,7 @@ package body Vhdl.Sem_Stmts is
 
          case Get_Kind (Stmt) is
             when Iir_Kind_Concurrent_Simple_Signal_Assignment
-              | Iir_Kind_Simple_Signal_Assignment_Statement =>
+               | Iir_Kind_Simple_Signal_Assignment_Statement =>
                Wf_Chain := Get_Waveform_Chain (Stmt);
                Sem_Waveform_Chain (Wf_Chain, Constrained, Target_Type);
                if Done then
@@ -790,7 +818,7 @@ package body Vhdl.Sem_Stmts is
                end if;
 
             when Iir_Kind_Concurrent_Conditional_Signal_Assignment
-              | Iir_Kind_Conditional_Signal_Assignment_Statement =>
+               | Iir_Kind_Conditional_Signal_Assignment_Statement =>
                Cond_Wf := Get_Conditional_Waveform_Chain (Stmt);
                while Cond_Wf /= Null_Iir loop
                   Wf_Chain := Get_Waveform_Chain (Cond_Wf);
@@ -805,7 +833,8 @@ package body Vhdl.Sem_Stmts is
                   Cond_Wf := Get_Chain (Cond_Wf);
                end loop;
 
-            when Iir_Kind_Concurrent_Selected_Signal_Assignment =>
+            when Iir_Kind_Concurrent_Selected_Signal_Assignment
+               | Iir_Kind_Selected_Waveform_Assignment_Statement =>
                declare
                   El : Iir;
                begin
@@ -836,8 +865,18 @@ package body Vhdl.Sem_Stmts is
       end loop;
 
       case Get_Kind (Stmt) is
+         when Iir_Kind_Concurrent_Selected_Signal_Assignment
+            | Iir_Kind_Selected_Waveform_Assignment_Statement =>
+            --  The choices.
+            Sem_Selected_Signal_Assignment_Expression (Stmt);
+         when others =>
+            null;
+      end case;
+
+      case Get_Kind (Stmt) is
          when Iir_Kind_Concurrent_Simple_Signal_Assignment
-           | Iir_Kind_Concurrent_Conditional_Signal_Assignment =>
+           | Iir_Kind_Concurrent_Conditional_Signal_Assignment
+           | Iir_Kind_Concurrent_Selected_Signal_Assignment =>
             Sem_Guard (Stmt);
          when others =>
             null;
@@ -1841,7 +1880,8 @@ package body Vhdl.Sem_Stmts is
                Sem_Sequential_Statements_Internal
                  (Get_Sequential_Statement_Chain (Stmt));
             when Iir_Kind_Simple_Signal_Assignment_Statement
-               | Iir_Kind_Conditional_Signal_Assignment_Statement =>
+               | Iir_Kind_Conditional_Signal_Assignment_Statement
+               | Iir_Kind_Selected_Waveform_Assignment_Statement =>
                Sem_Passive_Statement (Stmt);
                Sem_Signal_Assignment (Stmt);
             when Iir_Kind_Signal_Force_Assignment_Statement
@@ -2383,37 +2423,6 @@ package body Vhdl.Sem_Stmts is
       Sem_Process_Statement (Proc);
    end Sem_Sensitized_Process_Statement;
 
-   procedure Sem_Concurrent_Selected_Signal_Assignment (Stmt: Iir)
-   is
-      Expr: Iir;
-      Chain : Iir;
-   begin
-      --  LRM 9.5  Concurrent Signal Assgnment Statements.
-      --  The process statement equivalent to a concurrent signal assignment
-      --  statement [...] is constructed as follows: [...]
-      --
-      --  LRM 9.5.2  Selected Signal Assignment
-      --  The characteristics of the selected expression, the waveforms and
-      --  the choices in the selected assignment statement must be such that
-      --  the case statement in the equivalent statement is a legal
-      --  statement
-
-      --  Target and waveforms.
-      Sem_Signal_Assignment (Stmt);
-
-      --  The choices.
-      Chain := Get_Selected_Waveform_Chain (Stmt);
-      Expr := Sem_Case_Expression (Get_Expression (Stmt));
-      if Expr /= Null_Iir then
-         Check_Read (Expr);
-         Set_Expression (Stmt, Expr);
-         Sem_Case_Choices (Expr, Chain, Get_Location (Stmt));
-         Set_Selected_Waveform_Chain (Stmt, Chain);
-      end if;
-
-      Sem_Guard (Stmt);
-   end Sem_Concurrent_Selected_Signal_Assignment;
-
    procedure Sem_Concurrent_Break_Statement (Stmt : Iir)
    is
       Sensitivity_List : Iir_List;
@@ -2571,16 +2580,12 @@ package body Vhdl.Sem_Stmts is
 
       case Get_Kind (Stmt) is
          when Iir_Kind_Concurrent_Simple_Signal_Assignment
-           | Iir_Kind_Concurrent_Conditional_Signal_Assignment =>
+            | Iir_Kind_Concurrent_Conditional_Signal_Assignment
+            | Iir_Kind_Concurrent_Selected_Signal_Assignment =>
             if Is_Passive then
                Error_Msg_Sem (+Stmt, "signal assignment forbidden in entity");
             end if;
             Sem_Signal_Assignment (Stmt);
-         when Iir_Kind_Concurrent_Selected_Signal_Assignment =>
-            if Is_Passive then
-               Error_Msg_Sem (+Stmt, "signal assignment forbidden in entity");
-            end if;
-            Sem_Concurrent_Selected_Signal_Assignment (Stmt);
          when Iir_Kind_Sensitized_Process_Statement =>
             Set_Passive_Flag (Stmt, Is_Passive);
             Sem_Sensitized_Process_Statement (Stmt);