Handle instantiation of protected types.

2 files changed, 49 insertions, 14 deletions

diff --git a/src/vhdl/sem_inst.adb b/src/vhdl/sem_inst.adb
index 2d39396f0..e76d9cada 100644
--- a/src/vhdl/sem_inst.adb
+++ b/src/vhdl/sem_inst.adb
@@ -357,20 +357,17 @@ package body Sem_Inst is
          Fields : constant Fields_Array := Get_Fields (Kind);
          F : Fields_Enum;
       begin
-         Res := Get_Instance (N);
-
-         if Kind = Iir_Kind_Interface_Constant_Declaration
-           and then Get_Identifier (N) = Null_Identifier
-           and then Res /= Null_Iir
-         then
-            --  Anonymous constant interface declarations are the only nodes
-            --  that can be shared.  Handle that very special case.
-            return Res;
-         end if;
-
-         --  RES is null_iir unless RES is also an instance (and therefore has
-         --  an origin).
-         --  pragma Assert (Res = Null_Iir);
+         --  In general, Get_Instance (N) is Null_Iir.  There are two
+         --  exceptions:
+         --  - N is also an instance (instance within an uninstantiated
+         --    package).  As instances and origin share the same table,
+         --    Get_Instance returns the origin.  During instantiation, the old
+         --    value of Origin is saved so this case is correctly handled.
+         --  - N is shared, so it was already instantiated.  This happends only
+         --    for interface_constant of implicit operators.  In that case,
+         --    multiple instances are created for the same node, which is not
+         --    ideal.  That's still ok (if no infos are attached to the
+         --    interface) and is the price to pay for this optimization.
 
          --  Create a new node.
          Res := Create_Iir (Kind);
diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb
index d24700f3e..fef4957ac 100644
--- a/src/vhdl/translate/trans-chap2.adb
+++ b/src/vhdl/translate/trans-chap2.adb
@@ -1121,6 +1121,32 @@ package body Trans.Chap2 is
       end case;
    end Instantiate_Iir_List_Info;
 
+   --  B must be passed by reference.
+   procedure Adjust_Info_Basetype (B : access Ortho_Info_Basetype_Type;
+                                   Orig : access Ortho_Info_Basetype_Type) is
+   begin
+      case B.Kind is
+         when Kind_Type_Scalar =>
+            null;
+         when Kind_Type_Array
+           | Kind_Type_Record =>
+            null;
+         when Kind_Type_File =>
+            null;
+         when Kind_Type_Protected =>
+            B.Prot_Scope := Instantiate_Var_Scope (B.Prot_Scope);
+            Push_Instantiate_Var_Scope
+              (B.Prot_Scope'Unrestricted_access,
+               Orig.Prot_Scope'Unrestricted_access);
+            B.Prot_Prev_Scope := Instantiated_Var_Scope
+              (B.Prot_Prev_Scope);
+            B.Prot_Init_Instance := Instantiate_Subprg_Instance
+              (B.Prot_Init_Instance);
+            B.Prot_Final_Instance := Instantiate_Subprg_Instance
+              (B.Prot_Final_Instance);
+      end case;
+   end Adjust_Info_Basetype;
+
    function Copy_Info_Subtype (Src : Ortho_Info_Subtype_Type)
                               return Ortho_Info_Subtype_Type
    is
@@ -1155,6 +1181,8 @@ package body Trans.Chap2 is
                          B => Src.B,
                          S => Copy_Info_Subtype (Src.S),
                          Type_Rti => Src.Type_Rti);
+            Adjust_Info_Basetype (Dest.B'Unrestricted_Access,
+                                 Src.B'Unrestricted_Access);
             if Src.C /= null then
                Dest.C := new Complex_Type_Arr_Info'
                  (Mode_Value =>
@@ -1311,6 +1339,8 @@ package body Trans.Chap2 is
                   Push_Instantiate_Var_Scope
                     (Info.Subprg_Frame_Scope'Access,
                      Orig_Info.Subprg_Frame_Scope'Access);
+               when Kind_Type =>
+                  null;
                when others =>
                   null;
             end case;
@@ -1393,6 +1423,14 @@ package body Trans.Chap2 is
                when Kind_Subprg =>
                   Pop_Instantiate_Var_Scope
                     (Info.Subprg_Frame_Scope'Access);
+               when Kind_Type =>
+                  case Info.B.Kind is
+                     when Kind_Type_Protected =>
+                        Pop_Instantiate_Var_Scope
+                          (Info.B.Prot_Scope'Unrestricted_access);
+                     when others =>
+                        null;
+                  end case;
                when others =>
                   null;
             end case;