vhdl: clear associated_type in Sem_Generic_Association_Chain

So that it is cleared after use.

4 files changed, 83 insertions, 9 deletions

diff --git a/src/vhdl/vhdl-sem.adb b/src/vhdl/vhdl-sem.adb
index 528b642a1..174f1456e 100644
--- a/src/vhdl/vhdl-sem.adb
+++ b/src/vhdl/vhdl-sem.adb
@@ -445,6 +445,12 @@ package body Vhdl.Sem is
 
       Sem_Association_Chain
         (Inter_Chain, Assoc_Chain, True, Miss, Assoc_Parent, Match);
+
+      --  Clear associated type of interface type.
+      --  Should be part of Sem_Association_Chain, but needed only for
+      --  generics.
+      Clear_Interface_Associated (Inter_Chain);
+
       Set_Generic_Map_Aspect_Chain (Assoc_Parent, Assoc_Chain);
       if Match = Not_Compatible then
          return False;
diff --git a/src/vhdl/vhdl-sem_assocs.adb b/src/vhdl/vhdl-sem_assocs.adb
index a28ebe12e..f93eaaecf 100644
--- a/src/vhdl/vhdl-sem_assocs.adb
+++ b/src/vhdl/vhdl-sem_assocs.adb
@@ -2386,15 +2386,6 @@ package body Vhdl.Sem_Assocs is
       Has_Individual := False;
       Last_Assoc := Null_Iir;
 
-      --  Clear associated type of interface type.
-      Inter := Interface_Chain;
-      while Inter /= Null_Iir loop
-         if Get_Kind (Inter) = Iir_Kind_Interface_Type_Declaration then
-            Set_Associated_Type (Get_Type (Inter), Null_Iir);
-         end if;
-         Inter := Get_Chain (Inter);
-      end loop;
-
       --  Loop on every assoc element, try to match it.
       Inter := Interface_Chain;
       Last_Individual := Null_Iir;
diff --git a/src/vhdl/vhdl-utils.adb b/src/vhdl/vhdl-utils.adb
index 05c1dc0ee..6bd200cc3 100644
--- a/src/vhdl/vhdl-utils.adb
+++ b/src/vhdl/vhdl-utils.adb
@@ -691,6 +691,65 @@ package body Vhdl.Utils is
       end if;
    end Is_Copyback_Parameter;
 
+   procedure Set_Interface_Associated (Inter_Chain : Iir; Assoc_Chain : Iir)
+   is
+      Inter, Assoc_Inter, Assoc : Iir;
+   begin
+      Assoc := Assoc_Chain;
+      Assoc_Inter := Inter_Chain;
+      while Assoc /= Null_Node loop
+         Inter := Get_Association_Interface (Assoc, Assoc_Inter);
+         case Iir_Kinds_Interface_Declaration (Get_Kind (Inter)) is
+            when Iir_Kind_Interface_Type_Declaration =>
+               declare
+                  Tdef : constant Iir := Get_Interface_Type_Definition (Inter);
+               begin
+                  pragma Assert (Get_Associated_Type (Tdef) = Null_Iir);
+                  Set_Associated_Type (Tdef, Get_Actual_Type (Assoc));
+               end;
+               --  TODO: subprograms ?
+            when Iir_Kind_Interface_Package_Declaration =>
+               pragma Assert (Get_Associated_Package (Inter) = Null_Iir);
+               Set_Associated_Package
+                 (Inter, Get_Named_Entity (Get_Actual (Assoc)));
+            when Iir_Kinds_Interface_Subprogram_Declaration =>
+               pragma Assert (Get_Associated_Subprogram (Inter) = Null_Iir);
+               Set_Associated_Subprogram
+                 (Inter, Get_Named_Entity (Get_Actual (Assoc)));
+            when Iir_Kinds_Interface_Object_Declaration
+               | Iir_Kind_Interface_Terminal_Declaration =>
+               null;
+         end case;
+         Next_Association_Interface (Assoc, Assoc_Inter);
+      end loop;
+   end Set_Interface_Associated;
+
+   procedure Clear_Interface_Associated (Inter_Chain : Iir)
+   is
+      Inter : Iir;
+   begin
+      Inter := Inter_Chain;
+      while Inter /= Null_Node loop
+         case Iir_Kinds_Interface_Declaration (Get_Kind (Inter)) is
+            when Iir_Kind_Interface_Type_Declaration =>
+               declare
+                  Tdef : constant Iir := Get_Interface_Type_Definition (Inter);
+               begin
+                  Set_Associated_Type (Tdef, Null_Iir);
+               end;
+               --  TODO: subprograms ?
+            when Iir_Kind_Interface_Package_Declaration =>
+               Set_Associated_Package (Inter, Null_Iir);
+            when Iir_Kinds_Interface_Subprogram_Declaration =>
+               Set_Associated_Subprogram (Inter, Null_Iir);
+            when Iir_Kinds_Interface_Object_Declaration
+               | Iir_Kind_Interface_Terminal_Declaration =>
+               null;
+         end case;
+         Inter := Get_Chain (Inter);
+      end loop;
+   end Clear_Interface_Associated;
+
    function Find_Name_In_Flist (List : Iir_Flist; Lit : Name_Id) return Iir
    is
       El : Iir;
diff --git a/src/vhdl/vhdl-utils.ads b/src/vhdl/vhdl-utils.ads
index 01425a157..8cce0eb14 100644
--- a/src/vhdl/vhdl-utils.ads
+++ b/src/vhdl/vhdl-utils.ads
@@ -94,6 +94,18 @@ package Vhdl.Utils is
    --  interface (initialized to the association chain and interface chain).
    --  The function Get_Association_Interface return the interface associated
    --  to ASSOC,and Next_Association_Interface updates ASSOC and INTER.
+   --
+   --  Usage:
+   --    Assoc := Get_xxx_Association_Chain (X);
+   --    Assoc_Inter := Get_xxx_Declaration_Chain (Y);
+   --    while Assoc /= Null_Iir loop
+   --       Inter := Get_Association_Interface (Assoc, Assoc_Inter);
+   --       ...
+   --       Next_Association_Interface (Assoc, Assoc_Inter);
+   --    end loop;
+   --
+   --  Note: This iterates over association, so unassociated interfaces are
+   --   not iterated.
    function Get_Association_Interface (Assoc : Iir; Inter : Iir) return Iir;
    procedure Next_Association_Interface
      (Assoc : in out Iir; Inter : in out Iir);
@@ -116,6 +128,12 @@ package Vhdl.Utils is
    --  variable).
    function Is_Copyback_Parameter (Inter : Iir) return Boolean;
 
+   --  Set/clear the Associated_XXX fields of type, package and subprogram
+   --  interfaces.
+   --  For set, check they were previously cleared.
+   procedure Set_Interface_Associated (Inter_Chain : Iir; Assoc_Chain : Iir);
+   procedure Clear_Interface_Associated (Inter_Chain : Iir);
+
    --  Duplicate enumeration literal LIT.
    function Copy_Enumeration_Literal (Lit : Iir) return Iir;