From c348e697dd910173d6d64dc78b43adad316e892a Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Wed, 8 Feb 2023 16:03:13 +0100
Subject: vhdl-canon: remove signal parameters for all-sensitized processes.

Fix #2344
---
 src/vhdl/vhdl-canon.adb    | 44 +++++++++++++++++++++++++++++++++++++++++++-
 src/vhdl/vhdl-sem_expr.adb |  7 -------
 src/vhdl/vhdl-utils.adb    |  7 +++++++
 src/vhdl/vhdl-utils.ads    |  5 ++++-
 4 files changed, 54 insertions(+), 9 deletions(-)

(limited to 'src')

diff --git a/src/vhdl/vhdl-canon.adb b/src/vhdl/vhdl-canon.adb
index 6cb8ca5c0..906a4720b 100644
--- a/src/vhdl/vhdl-canon.adb
+++ b/src/vhdl/vhdl-canon.adb
@@ -696,7 +696,49 @@ package body Vhdl.Canon is
       Set_Seen_Flag (Proc, True);
       Clear_Seen_Flag (Proc);
 
-      return Res;
+      --  Filter out signal parameters.
+      declare
+         It, It2 : List_Iterator;
+         Res2 : Iir_List;
+         El, El2 : Iir;
+         Base : Iir;
+      begin
+         Res2 := Null_Iir_List;
+
+         It := List_Iterate_Safe (Res);
+         while Is_Valid (It) loop
+            El := Get_Element (It);
+            Base := Get_Object_Prefix (El);
+            if Is_Signal_Parameter (Base) then
+               --  Discard
+               if Res2 = Null_Iir_List then
+                  --  So we need a different list to discard some elements.
+                  --  Duplicate the list until EL.
+                  Res2 := Create_Iir_List;
+                  It2 := List_Iterate (Res);
+                  loop
+                     El2 := Get_Element (It2);
+                     exit when El2 = El;
+                     Append_Element (Res2, El2);
+                     Next (It2);
+                  end loop;
+               end if;
+            else
+               if Res2 /= Null_Iir_List then
+                  Append_Element (Res2, El);
+               end if;
+            end if;
+            Next (It);
+         end loop;
+
+         if Res2 /= Null_Iir_List then
+            Destroy_Iir_List (Res);
+            return Res2;
+         else
+            --  No element removed.
+            return Res;
+         end if;
+      end;
    end Canon_Extract_Sensitivity_Process;
 
    procedure Canon_Aggregate_Expression (Expr: Iir)
diff --git a/src/vhdl/vhdl-sem_expr.adb b/src/vhdl/vhdl-sem_expr.adb
index 6ae3f818b..4961a3556 100644
--- a/src/vhdl/vhdl-sem_expr.adb
+++ b/src/vhdl/vhdl-sem_expr.adb
@@ -4731,13 +4731,6 @@ package body Vhdl.Sem_Expr is
       return Expr;
    end Sem_Qualified_Expression;
 
-   function Is_Signal_Parameter (Obj : Iir) return Boolean is
-   begin
-      return Get_Kind (Obj) = Iir_Kind_Interface_Signal_Declaration
-        and then
-        Get_Kind (Get_Parent (Obj)) in Iir_Kinds_Subprogram_Declaration;
-   end Is_Signal_Parameter;
-
    function Can_Interface_Be_Read (Inter : Iir) return Boolean is
    begin
       case Get_Mode (Inter) is
diff --git a/src/vhdl/vhdl-utils.adb b/src/vhdl/vhdl-utils.adb
index 084e39e5a..a9f2c76dd 100644
--- a/src/vhdl/vhdl-utils.adb
+++ b/src/vhdl/vhdl-utils.adb
@@ -562,6 +562,13 @@ package body Vhdl.Utils is
       end if;
    end Is_Quantity_Name;
 
+   function Is_Signal_Parameter (Obj : Iir) return Boolean is
+   begin
+      return Get_Kind (Obj) = Iir_Kind_Interface_Signal_Declaration
+        and then
+        Get_Kind (Get_Parent (Obj)) in Iir_Kinds_Subprogram_Declaration;
+   end Is_Signal_Parameter;
+
    function Get_Interface_Of_Formal (Formal : Iir) return Iir
    is
       El : Iir;
diff --git a/src/vhdl/vhdl-utils.ads b/src/vhdl/vhdl-utils.ads
index 4ff81b011..8ea5ac786 100644
--- a/src/vhdl/vhdl-utils.ads
+++ b/src/vhdl/vhdl-utils.ads
@@ -64,7 +64,6 @@ package Vhdl.Utils is
    function Get_Object_Prefix (Name: Iir; With_Alias : Boolean := True)
                               return Iir;
 
-
    --  Return TRUE if NAME is a name that designate an object (ie a constant,
    --  a variable, a signal or a file).
    function Is_Object_Name (Name : Iir) return Boolean;
@@ -85,6 +84,10 @@ package Vhdl.Utils is
    --  Return TRUE iff EXPR is a quantity name.
    function Is_Quantity_Name (Expr : Iir) return Boolean;
 
+   --  Return TRUE iff OBJ is a signal parameter (an interface signal of a
+   --  subprogram).  Works only for base names.
+   function Is_Signal_Parameter (Obj : Iir) return Boolean;
+
    --  Get the interface corresponding to the formal name FORMAL.  This is
    --  always an interface, even if the formal is a name.
    function Get_Interface_Of_Formal (Formal : Iir) return Iir;
-- 
cgit v1.2.3