vhdl/translate: rework object type elaboration. For #641

8 files changed, 93 insertions, 41 deletions

diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb
index 6016a4c6e..6d918b63a 100644
--- a/src/vhdl/translate/trans-chap2.adb
+++ b/src/vhdl/translate/trans-chap2.adb
@@ -148,7 +148,7 @@ package body Trans.Chap2 is
       --  Translate interface types.
       Inter := Get_Interface_Declaration_Chain (Spec);
       while Inter /= Null_Iir loop
-         Chap3.Translate_Object_Subtype (Inter);
+         Chap3.Translate_Object_Subtype_Indication (Inter);
          Inter := Get_Chain (Inter);
       end loop;
 
@@ -211,7 +211,7 @@ package body Trans.Chap2 is
       --  Translate interface types.
       Inter := Get_Interface_Declaration_Chain (Spec);
       while Inter /= Null_Iir loop
-         Chap3.Elab_Object_Subtype (Get_Type (Inter));
+         Chap3.Elab_Object_Subtype_Indication (Inter);
          Inter := Get_Chain (Inter);
       end loop;
    end Elab_Subprogram_Interfaces;
diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb
index 1f7472938..652087b92 100644
--- a/src/vhdl/translate/trans-chap3.adb
+++ b/src/vhdl/translate/trans-chap3.adb
@@ -2465,6 +2465,7 @@ package body Trans.Chap3 is
 
    procedure Elab_Type_Definition_Depend is new Handle_Anonymous_Subtypes
      (Handle_A_Subtype => Elab_Type_Definition);
+
    procedure Elab_Type_Definition (Def : Iir) is
    begin
       case Get_Kind (Def) is
@@ -2528,30 +2529,71 @@ package body Trans.Chap3 is
       Pop_Identifier_Prefix (Mark);
    end Translate_Anonymous_Subtype_Definition;
 
-   procedure Translate_Object_Subtype (Decl      : Iir;
-                                       With_Vars : Boolean := True)
+   procedure Translate_Object_Subtype_Definition
+     (Decl : Iir; Def : Iir; With_Vars : Boolean := True)
    is
-      Def : constant Iir := Get_Type (Decl);
       Parent_Type : Iir;
       Mark  : Id_Mark_Type;
       Mark2 : Id_Mark_Type;
    begin
-      if Is_Anonymous_Type_Definition (Def) then
-         Push_Identifier_Prefix (Mark, Get_Identifier (Decl));
-         Push_Identifier_Prefix (Mark2, "OT");
-         Parent_Type := Get_Parent_Type (Def);
-         Chap3.Translate_Subtype_Definition (Def, Parent_Type, With_Vars);
-         Pop_Identifier_Prefix (Mark2);
-         Pop_Identifier_Prefix (Mark);
+      Push_Identifier_Prefix (Mark, Get_Identifier (Decl));
+      Push_Identifier_Prefix (Mark2, "OT");
+      Parent_Type := Get_Parent_Type (Def);
+      Chap3.Translate_Subtype_Definition (Def, Parent_Type, With_Vars);
+      Pop_Identifier_Prefix (Mark2);
+      Pop_Identifier_Prefix (Mark);
+   end Translate_Object_Subtype_Definition;
+
+   procedure Translate_Object_Subtype_Indication (Decl      : Iir;
+                                                  With_Vars : Boolean := True)
+   is
+      Def : constant Iir := Get_Type (Decl);
+   begin
+      if not Is_Anonymous_Type_Definition (Def) then
+         --  The type refers to a declared type, so already handled.
+         return;
       end if;
-   end Translate_Object_Subtype;
 
-   procedure Elab_Object_Subtype (Def : Iir) is
+      declare
+         Ind : constant Iir := Get_Subtype_Indication (Decl);
+      begin
+         if Ind /= Null_Iir
+           and then Get_Kind (Ind) = Iir_Kind_Subtype_Attribute
+         then
+            if Is_Fully_Constrained_Type (Get_Type (Get_Prefix (Ind))) then
+               return;
+            end if;
+            raise Internal_Error;
+         else
+            Translate_Object_Subtype_Definition (Decl, Def, With_Vars);
+         end if;
+      end;
+   end Translate_Object_Subtype_Indication;
+
+   procedure Elab_Object_Subtype_Indication (Decl : Iir)
+   is
+      Def : constant Iir := Get_Type (Decl);
    begin
-      if Is_Anonymous_Type_Definition (Def) then
-         Elab_Type_Definition (Def);
+      if not Is_Anonymous_Type_Definition (Def) then
+         --  The type refers to a declared type, so already handled.
+         return;
       end if;
-   end Elab_Object_Subtype;
+
+      declare
+         Ind : constant Iir := Get_Subtype_Indication (Decl);
+      begin
+         if Ind /= Null_Iir
+           and then Get_Kind (Ind) = Iir_Kind_Subtype_Attribute
+         then
+            if Is_Fully_Constrained_Type (Get_Type (Get_Prefix (Ind))) then
+               return;
+            end if;
+            raise Internal_Error;
+         else
+            Elab_Type_Definition (Def);
+         end if;
+      end;
+   end Elab_Object_Subtype_Indication;
 
    procedure Elab_Type_Declaration (Decl : Iir) is
    begin
diff --git a/src/vhdl/translate/trans-chap3.ads b/src/vhdl/translate/trans-chap3.ads
index 7e252f521..aa5a98742 100644
--- a/src/vhdl/translate/trans-chap3.ads
+++ b/src/vhdl/translate/trans-chap3.ads
@@ -21,9 +21,9 @@ package Trans.Chap3 is
    --  a subtype.
    --  This can be done only for a declaration.
    --  DECL must have an identifier and a type.
-   procedure Translate_Object_Subtype
+   procedure Translate_Object_Subtype_Indication
      (Decl : Iir; With_Vars : Boolean := True);
-   procedure Elab_Object_Subtype (Def : Iir);
+   procedure Elab_Object_Subtype_Indication (Decl : Iir);
 
    --  Translate the subtype of a literal.
    --  This can be done not at declaration time, ie no variables are created
diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb
index f2ed9cd33..9a98e79ee 100644
--- a/src/vhdl/translate/trans-chap4.adb
+++ b/src/vhdl/translate/trans-chap4.adb
@@ -114,19 +114,16 @@ package body Trans.Chap4 is
       Info     : Object_Info_Acc;
       Tinfo    : Type_Info_Acc;
       Def      : Iir;
-      Val      : Iir;
+      Val      : constant Iir := Get_Default_Value (El);
       Storage  : O_Storage;
       Deferred : Iir;
    begin
-      Def := Get_Type (El);
-      Val := Get_Default_Value (El);
-
       --  Be sure the object type was translated.
       if Get_Kind (El) = Iir_Kind_Constant_Declaration
         and then Get_Deferred_Declaration_Flag (El) = False
         and then Get_Deferred_Declaration (El) /= Null_Iir
       then
-         --  This is a full constant declaration which complete a previous
+         --  This is a full constant declaration which completes a previous
          --  incomplete constant declaration.
          --
          --  Do not create the subtype of this full constant declaration,
@@ -137,8 +134,9 @@ package body Trans.Chap4 is
          Info := Get_Info (Deferred);
          Set_Info (El, Info);
       else
-         Chap3.Translate_Object_Subtype (El);
+         Chap3.Translate_Object_Subtype_Indication (El);
          Info := Add_Info (El, Kind_Object);
+         Def := Get_Type (El);
       end if;
 
       Tinfo := Get_Info (Def);
@@ -197,7 +195,9 @@ package body Trans.Chap4 is
       Type_Info    : Type_Info_Acc;
       Info         : Signal_Info_Acc;
    begin
-      Chap3.Translate_Object_Subtype (Decl);
+      if Get_Kind (Decl) /= Iir_Kind_Anonymous_Signal_Declaration then
+         Chap3.Translate_Object_Subtype_Indication (Decl);
+      end if;
 
       Type_Info := Get_Info (Sig_Type_Def);
       Info := Add_Info (Decl, Kind_Signal);
@@ -494,7 +494,12 @@ package body Trans.Chap4 is
       Size : O_Enode;
    begin
       --  Elaborate subtype.
-      Chap3.Elab_Object_Subtype (Obj_Type);
+      case Get_Kind (Obj) is
+         when Iir_Kind_Attribute_Value =>
+            null;
+         when others =>
+            Chap3.Elab_Object_Subtype_Indication (Obj);
+      end case;
 
       Type_Info := Get_Info (Obj_Type);
 
@@ -1076,12 +1081,18 @@ package body Trans.Chap4 is
 
       Open_Temp;
 
-      Chap3.Elab_Object_Subtype (Sig_Type);
+      if Get_Kind (Decl) /= Iir_Kind_Anonymous_Signal_Declaration then
+         Chap3.Elab_Object_Subtype_Indication (Decl);
+      end if;
+
       Type_Info := Get_Info (Sig_Type);
 
       if Type_Info.Type_Mode in Type_Mode_Unbounded then
          --  Unbounded types are only allowed for ports; in that case the
          --  bounds have already been set.
+         pragma Assert (Is_Port);
+
+         --  Allocate storage.
          if Has_Copy then
             Name_Sig := Chap6.Translate_Name (Decl, Mode_Signal);
             Name_Val := Mnode_Null;
@@ -1586,7 +1597,7 @@ package body Trans.Chap4 is
       Atype     : O_Tnode;
       Id        : Var_Ident_Type;
    begin
-      Chap3.Translate_Object_Subtype (Decl, True);
+      Chap3.Translate_Object_Subtype_Indication (Decl, True);
 
       Info := Add_Info (Decl, Kind_Alias);
       if Is_Signal_Name (Decl) then
@@ -1659,7 +1670,7 @@ package body Trans.Chap4 is
    begin
       New_Debug_Line_Stmt (Get_Line_Number (Decl));
 
-      Chap3.Elab_Object_Subtype (Decl_Type);
+      Chap3.Elab_Object_Subtype_Indication (Decl);
 
       Open_Temp;
 
@@ -1841,8 +1852,8 @@ package body Trans.Chap4 is
             Create_File_Object (Decl);
 
          when Iir_Kind_Attribute_Declaration =>
-            --  Useless as attribute declarations have a type mark.
-            Chap3.Translate_Object_Subtype (Decl);
+            --  Attribute declarations have a type mark.
+            null;
 
          when Iir_Kind_Attribute_Specification =>
             Chap5.Translate_Attribute_Specification (Decl);
@@ -2607,7 +2618,8 @@ package body Trans.Chap4 is
                Need_Final := True;
 
             when Iir_Kind_Attribute_Declaration =>
-               Chap3.Elab_Object_Subtype (Get_Type (Decl));
+               --  An attribute declaration can only have a type mark.
+               null;
 
             when Iir_Kind_Attribute_Specification =>
                Chap5.Elab_Attribute_Specification (Decl);
diff --git a/src/vhdl/translate/trans-chap5.adb b/src/vhdl/translate/trans-chap5.adb
index b8264f3db..a1f89f57f 100644
--- a/src/vhdl/translate/trans-chap5.adb
+++ b/src/vhdl/translate/trans-chap5.adb
@@ -101,8 +101,6 @@ package body Trans.Chap5 is
       Expr : constant Iir := Get_Expression (Spec);
       Val    : Iir;
    begin
-      Chap3.Elab_Object_Subtype (Get_Type (Expr));
-
       Val := Get_Attribute_Value_Spec_Chain (Spec);
       while Is_Valid (Val) loop
          Chap4.Elab_Object_Value (Val, Expr);
@@ -844,7 +842,7 @@ package body Trans.Chap5 is
                   Bounds      : Mnode;
                begin
                   Set_Map_Env (Formal_Env);
-                  Chap3.Elab_Object_Subtype (Formal_Type);
+                  Chap3.Elab_Object_Subtype_Indication (Formal); -- FIXME?
                   Type_Info := Get_Info (Formal_Type);
                   Formal_Node := Get_Var
                     (Obj_Info.Object_Var, Type_Info, Mode_Value);
diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb
index ace7f61b6..acda82aff 100644
--- a/src/vhdl/translate/trans-chap8.adb
+++ b/src/vhdl/translate/trans-chap8.adb
@@ -534,7 +534,7 @@ package body Trans.Chap8 is
       Range_Type : O_Tnode;
    begin
       --  Iterator range.
-      Chap3.Translate_Object_Subtype (Iterator, False);
+      Chap3.Translate_Object_Subtype_Indication (Iterator, False);
 
       --  Iterator variable.
       It_Info := Add_Info (Iterator, Kind_Iterator);
diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb
index 5ec57edc7..2c7fd68cc 100644
--- a/src/vhdl/translate/trans-chap9.adb
+++ b/src/vhdl/translate/trans-chap9.adb
@@ -894,7 +894,7 @@ package body Trans.Chap9 is
    begin
       Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
 
-      Chap3.Translate_Object_Subtype (Param, True);
+      Chap3.Translate_Object_Subtype_Indication (Param, True);
 
       Info := Add_Info (Bod, Kind_Block);
       Chap1.Start_Block_Decl (Bod);
@@ -2465,7 +2465,7 @@ package body Trans.Chap9 is
       Open_Temp;
 
       --  Evaluate iterator range.
-      Chap3.Elab_Object_Subtype (Iter_Type);
+      Chap3.Elab_Object_Subtype_Indication (Iter);
 
       Range_Ptr := Create_Temp_Ptr
         (Iter_Type_Info.B.Range_Ptr_Type,
@@ -2580,7 +2580,7 @@ package body Trans.Chap9 is
       Open_Temp;
 
       --  Evaluate iterator range.
-      Chap3.Elab_Object_Subtype (Iter_Type);
+      Chap3.Elab_Object_Subtype_Indication (Iter);
 
       --  Allocate instances.
       Var_Inst := Create_Temp_Init
diff --git a/src/vhdl/vhdl-sem_names.adb b/src/vhdl/vhdl-sem_names.adb
index 7f1766b5b..9463b1b37 100644
--- a/src/vhdl/vhdl-sem_names.adb
+++ b/src/vhdl/vhdl-sem_names.adb
@@ -3630,7 +3630,7 @@ package body Vhdl.Sem_Names is
       --  The type defined by 'subtype is always constrained.  Create
       --  a subtype if it is not.
       Attr_Type := Get_Type (Prefix_Name);
-      if False then
+      if not Is_Fully_Constrained_Type (Attr_Type) then
          Attr_Type := Sem_Types.Build_Constrained_Subtype (Attr_Type, Attr);
       end if;