aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/psl/psl-build.adb18
-rw-r--r--src/psl/psl-disp_nfas.adb16
-rw-r--r--src/psl/psl-optimize.adb7
-rw-r--r--src/synth/synth-vhdl_stmts.adb2
-rw-r--r--src/vhdl/vhdl-canon.adb6
-rw-r--r--src/vhdl/vhdl-parse.adb31
-rw-r--r--src/vhdl/vhdl-sem_stmts.adb89
-rw-r--r--testsuite/gna/issue2381/test.vhdl27
-rwxr-xr-xtestsuite/gna/issue2381/testsuite.sh11
-rw-r--r--testsuite/synth/case01/case07.vhdl17
-rwxr-xr-xtestsuite/synth/case01/testsuite.sh5
11 files changed, 165 insertions, 64 deletions
diff --git a/src/psl/psl-build.adb b/src/psl/psl-build.adb
index 0609c7405..02c4961ff 100644
--- a/src/psl/psl-build.adb
+++ b/src/psl/psl-build.adb
@@ -418,17 +418,29 @@ package body PSL.Build is
return Res;
end Build_Star_Repeat;
- function Build_Plus_Repeat (N : Node) return NFA is
+ function Build_Plus_Repeat (N : Node) return NFA
+ is
Res : NFA;
- Start, Final : NFA_State;
+ Start, Final, Src : NFA_State;
T : NFA_Edge;
begin
Res := Build_SERE_FA (Get_Sequence (N));
Start := Get_Start_State (Res);
Final := Get_Final_State (Res);
+
+ -- Create edges from pre-final to start.
T := Get_First_Dest_Edge (Final);
while T /= No_Edge loop
- Add_Edge (Get_Edge_Src (T), Start, Get_Edge_Expr (T));
+ Src := Get_Edge_Src (T);
+ if Src /= Start then
+ -- Normal before-final to start.
+ Add_Edge (Src, Start, Get_Edge_Expr (T));
+ else
+ -- Do not create edges from start to start, as this is not the
+ -- correct sequence (it will accept words like 001, while
+ -- the first letter must be 1).
+ Add_Edge (Final, Final, Get_Edge_Expr (T));
+ end if;
T := Get_Next_Src_Edge (T);
end loop;
return Res;
diff --git a/src/psl/psl-disp_nfas.adb b/src/psl/psl-disp_nfas.adb
index c63995ca3..c510af904 100644
--- a/src/psl/psl-disp_nfas.adb
+++ b/src/psl/psl-disp_nfas.adb
@@ -14,7 +14,8 @@
-- You should have received a copy of the GNU General Public License
-- along with this program. If not, see <gnu.org/licenses>.
-with Ada.Text_IO; use Ada.Text_IO;
+with Simple_IO; use Simple_IO;
+with Utils_IO; use Utils_IO;
with Types; use Types;
with PSL.Types;
with PSL.Prints; use PSL.Prints;
@@ -129,14 +130,11 @@ package body PSL.Disp_NFAs is
procedure Dump_NFA (N : NFA)
is
use PSL.Types;
- procedure Disp_State (S : NFA_State)
- is
- Str : constant String := Int32'Image (Get_State_Label (S));
- S1 : constant String := NFA_State'Image (S);
+ procedure Disp_State (S : NFA_State) is
begin
- Put (Str (2 .. Str'Last));
+ Put_Trim (Int32'Image (Get_State_Label (S)));
Put ("[");
- Put (S1 (2 .. S1'Last));
+ Put_Trim (NFA_State'Image (S));
Put ("]");
end Disp_State;
@@ -161,12 +159,16 @@ package body PSL.Disp_NFAs is
if Get_Epsilon_NFA (N) then
Put (", epsilon");
end if;
+
+ Put (" notation: label[state]");
New_Line;
S := Get_First_State (N);
while S /= No_State loop
E := Get_First_Src_Edge (S);
while E /= No_Edge loop
+ Put_Trim (NFA_Edge'Image (E));
+ Put (": ");
Disp_State (S);
Put (" -> ");
Disp_State (Get_Edge_Dest (E));
diff --git a/src/psl/psl-optimize.adb b/src/psl/psl-optimize.adb
index 450a933c9..a2b5fbd9e 100644
--- a/src/psl/psl-optimize.adb
+++ b/src/psl/psl-optimize.adb
@@ -246,7 +246,8 @@ package body PSL.Optimize is
Next_E_State := Get_Edge_State (Next_E);
Next_Next_E := Get_Next_Edge_Reverse (Next_E);
if Next_E_State = E_State then
- -- Identical edge: remove the duplicate.
+ -- Identical edge (same edge expression, same states):
+ -- remove the duplicate.
Remove_Edge (Next_E);
elsif Are_States_Identical (E_State, Next_E_State) then
Merge_State_Reverse (N, E_State, Next_E_State);
@@ -308,12 +309,16 @@ package body PSL.Optimize is
while S /= No_State loop
Edges := (others => No_Edge);
+
+ -- Iterate on edges whose source is S.
E := Get_First_Src_Edge (S);
while E /= No_Edge loop
Next_E := Get_Next_Src_Edge (E);
D := Get_Edge_Dest (E);
L_D := Get_State_Label (D);
if Edges (L_D) /= No_Edge then
+ -- There is already an edge with the same source and the
+ -- same destination label.
Set_Edge_Expr
(Edges (L_D),
Build_Bool_Or (Get_Edge_Expr (Edges (L_D)),
diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb
index 4fae9b5a8..9a8e0e36a 100644
--- a/src/synth/synth-vhdl_stmts.adb
+++ b/src/synth/synth-vhdl_stmts.adb
@@ -3951,6 +3951,8 @@ package body Synth.Vhdl_Stmts is
Synth_Simple_Signal_Assignment (C.Inst, Stmt);
when Iir_Kind_Conditional_Signal_Assignment_Statement =>
Synth_Conditional_Signal_Assignment (C.Inst, Stmt);
+ when Iir_Kind_Selected_Waveform_Assignment_Statement =>
+ Synth_Selected_Signal_Assignment (C.Inst, Stmt);
when Iir_Kind_Variable_Assignment_Statement =>
Synth_Variable_Assignment (C.Inst, Stmt);
when Iir_Kind_Conditional_Variable_Assignment_Statement =>
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);
diff --git a/testsuite/gna/issue2381/test.vhdl b/testsuite/gna/issue2381/test.vhdl
new file mode 100644
index 000000000..6dd777816
--- /dev/null
+++ b/testsuite/gna/issue2381/test.vhdl
@@ -0,0 +1,27 @@
+
+
+library ieee;
+use ieee.std_logic_1164.all;
+use ieee.numeric_std.all;
+
+entity test is
+end entity;
+
+architecture rtl of test is
+ signal a,b,c,d,e: std_logic;
+begin
+
+ COMBINATORIC: process( all ) is
+ begin
+ case a is
+ when '0' =>
+ with b select c <=
+ '0' when '1',
+ '1' when '0',
+ '0' when others;
+ when others =>
+ null;
+ end case;
+ end process;
+
+end architecture rtl;
diff --git a/testsuite/gna/issue2381/testsuite.sh b/testsuite/gna/issue2381/testsuite.sh
new file mode 100755
index 000000000..1d84c0f57
--- /dev/null
+++ b/testsuite/gna/issue2381/testsuite.sh
@@ -0,0 +1,11 @@
+#! /bin/sh
+
+. ../../testenv.sh
+
+export GHDL_STD_FLAGS=--std=08
+analyze test.vhdl
+elab_simulate test
+
+clean
+
+echo "Test successful"
diff --git a/testsuite/synth/case01/case07.vhdl b/testsuite/synth/case01/case07.vhdl
new file mode 100644
index 000000000..deecf1e75
--- /dev/null
+++ b/testsuite/synth/case01/case07.vhdl
@@ -0,0 +1,17 @@
+library ieee;
+use ieee.std_logic_1164.all;
+
+entity case07 is
+ port (a : std_logic_vector (4 downto 0);
+ o : out std_logic);
+end case07;
+
+architecture behav of case07 is
+begin
+ process (a)
+ begin
+ with a select o <=
+ '1' when "00000",
+ '0' when others;
+ end process;
+end behav;
diff --git a/testsuite/synth/case01/testsuite.sh b/testsuite/synth/case01/testsuite.sh
index ef530ebe1..673d3beec 100755
--- a/testsuite/synth/case01/testsuite.sh
+++ b/testsuite/synth/case01/testsuite.sh
@@ -6,7 +6,8 @@ for t in case01 case02 case03 case04; do
synth_tb $t
done
-synth case05.vhdl -e case05 > syn_case05.vhdl
-synth case06.vhdl -e case06 > syn_case06.vhdl
+for t in case05 case06 case07; do
+ synth_only $t
+done
echo "Test successful"
generated by cgit v1.2.3 (git 2.25.1) at 2025-05-29 17:26:32 +0000