vhdl08: handle interface type in generic-mapped package

5 files changed, 131 insertions, 6 deletions

diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb
index 8187ffd36..d26bbfe6e 100644
--- a/src/vhdl/sem.adb
+++ b/src/vhdl/sem.adb
@@ -2604,13 +2604,28 @@ package body Sem is
       Push_Signals_Declarative_Part (Implicit, Decl);
 
       if Header /= Null_Iir then
-         Sem_Interface_Chain
-           (Get_Generic_Chain (Header), Generic_Interface_List);
-         if Get_Generic_Map_Aspect_Chain (Header) /= Null_Iir then
-            if not Sem_Generic_Association_Chain (Header, Header) then
-               null;
+         declare
+            Generic_Chain : constant Iir := Get_Generic_Chain (Header);
+            Generic_Map : constant Iir :=
+              Get_Generic_Map_Aspect_Chain (Header);
+            El : Iir;
+         begin
+            Sem_Interface_Chain (Generic_Chain, Generic_Interface_List);
+            if Generic_Map /= Null_Iir then
+               if Sem_Generic_Association_Chain (Header, Header) then
+                  El := Get_Generic_Map_Aspect_Chain (Header);
+                  while Is_Valid (El) loop
+                     if Get_Kind (El) = Iir_Kind_Association_Element_Type then
+                        Sem_Inst.Substitute_On_Chain
+                          (Generic_Chain,
+                           Get_Type (Get_Associated_Interface (El)),
+                           Get_Type (Get_Named_Entity (Get_Actual (El))));
+                     end if;
+                     El := Get_Chain (El);
+                  end loop;
+               end if;
             end if;
-         end if;
+         end;
       end if;
 
       Sem_Declaration_Chain (Decl);
diff --git a/src/vhdl/sem_inst.adb b/src/vhdl/sem_inst.adb
index ae4a6975b..8799ac7a5 100644
--- a/src/vhdl/sem_inst.adb
+++ b/src/vhdl/sem_inst.adb
@@ -648,4 +648,106 @@ package body Sem_Inst is
       Instantiate_Loc := Prev_Loc;
       Restore_Origin (Mark);
    end Instantiate_Package_Declaration;
+
+   procedure Substitute_On_Iir_List (L : Iir_List; E : Iir; Rep : Iir);
+
+   procedure Substitute_On_Iir (N : Iir; E : Iir; Rep : Iir) is
+   begin
+      if N = Null_Iir then
+         return;
+      end if;
+
+      pragma Assert (N /= E);
+
+      declare
+         use Nodes_Meta;
+         Kind : constant Iir_Kind := Get_Kind (N);
+         Fields : constant Fields_Array := Get_Fields (Kind);
+         F : Fields_Enum;
+      begin
+         for I in Fields'Range loop
+            F := Fields (I);
+
+            case Get_Field_Type (F) is
+               when Type_Iir =>
+                  declare
+                     S : constant Iir := Get_Iir (N, F);
+                  begin
+                     if S = E then
+                        --  Substitute
+                        Set_Iir (N, F, Rep);
+                        pragma Assert (Get_Field_Attribute (F) = Attr_Ref);
+                     else
+                        case Get_Field_Attribute (F) is
+                           when Attr_None =>
+                              Substitute_On_Iir (S, E, Rep);
+                           when Attr_Ref =>
+                              null;
+                           when Attr_Maybe_Ref =>
+                              if not Get_Is_Ref (N) then
+                                 Substitute_On_Iir (S, E, Rep);
+                              end if;
+                           when Attr_Chain =>
+                              Substitute_On_Chain (S, E, Rep);
+                           when Attr_Chain_Next =>
+                              null;
+                           when Attr_Of_Ref =>
+                              --  Can only appear in list.
+                              raise Internal_Error;
+                        end case;
+                     end if;
+                  end;
+               when Type_Iir_List =>
+                  declare
+                     S : constant Iir_List := Get_Iir_List (N, F);
+                  begin
+                     case Get_Field_Attribute (F) is
+                        when Attr_None =>
+                           Substitute_On_Iir_List (S, E, Rep);
+                        when Attr_Of_Ref
+                          | Attr_Ref =>
+                           null;
+                        when others =>
+                           --  Ref is specially handled in Instantiate_Iir.
+                           --  Others cannot appear for lists.
+                           raise Internal_Error;
+                     end case;
+                  end;
+               when others =>
+                  null;
+            end case;
+         end loop;
+      end;
+   end Substitute_On_Iir;
+
+   procedure Substitute_On_Iir_List (L : Iir_List; E : Iir; Rep : Iir)
+   is
+      El : Iir;
+   begin
+      case L is
+         when Null_Iir_List
+           | Iir_List_All
+           | Iir_List_Others =>
+            return;
+         when others =>
+            for I in Natural loop
+               El := Get_Nth_Element (L, I);
+               exit when El = Null_Iir;
+
+               Substitute_On_Iir (El, E, Rep);
+            end loop;
+      end case;
+   end Substitute_On_Iir_List;
+
+   procedure Substitute_On_Chain (Chain : Iir; E : Iir; Rep : Iir)
+   is
+      El : Iir;
+   begin
+      El := Chain;
+      while Is_Valid (El) loop
+         Substitute_On_Iir (El, E, Rep);
+         El := Get_Chain (El);
+      end loop;
+   end Substitute_On_Chain;
+
 end Sem_Inst;
diff --git a/src/vhdl/sem_inst.ads b/src/vhdl/sem_inst.ads
index da8cd5d27..5da4a8d09 100644
--- a/src/vhdl/sem_inst.ads
+++ b/src/vhdl/sem_inst.ads
@@ -23,4 +23,8 @@ package Sem_Inst is
 
    --  Create declaration chain and generic declarations for INST from PKG.
    procedure Instantiate_Package_Declaration (Inst : Iir; Pkg : Iir);
+
+   --  In CHAIN, substitute all references to E by REP.
+   procedure Substitute_On_Chain (Chain : Iir; E : Iir; Rep : Iir);
+
 end Sem_Inst;
diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb
index a61246c57..ca0bff60b 100644
--- a/src/vhdl/translate/trans-chap4.adb
+++ b/src/vhdl/translate/trans-chap4.adb
@@ -1631,6 +1631,8 @@ package body Trans.Chap4 is
                Create_Object (Decl);
             when Iir_Kind_Interface_Package_Declaration =>
                Create_Package_Interface (Decl);
+            when Iir_Kind_Interface_Type_Declaration =>
+               null;
             when others =>
                Error_Kind ("translate_generic_chain", Decl);
          end case;
diff --git a/src/vhdl/translate/trans-chap5.adb b/src/vhdl/translate/trans-chap5.adb
index 7bdb84385..cc5f349d0 100644
--- a/src/vhdl/translate/trans-chap5.adb
+++ b/src/vhdl/translate/trans-chap5.adb
@@ -802,6 +802,8 @@ package body Trans.Chap5 is
                             (Actual_Info.Package_Instance_Body_Scope),
                         Uninst_Info.Package_Body_Ptr_Type));
                end;
+            when Iir_Kind_Association_Element_Type =>
+               null;
             when others =>
                Error_Kind ("elab_generic_map_aspect(1)", Assoc);
          end case;