translate: rework translate_object_subtype_indication.

Fix #2337

4 files changed, 78 insertions, 61 deletions

diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb
index 141bfca6e..b60cf343c 100644
--- a/src/vhdl/translate/trans-chap3.adb
+++ b/src/vhdl/translate/trans-chap3.adb
@@ -2700,8 +2700,9 @@ package body Trans.Chap3 is
    procedure Translate_Object_Subtype_Indication (Decl      : Iir;
                                                   With_Vars : Boolean := True)
    is
-      Def : Iir;
       Ind : Iir;
+      Ind_Type : Iir;
+      Def : Iir;
       Mark  : Id_Mark_Type;
       Mark2 : Id_Mark_Type;
    begin
@@ -2722,7 +2723,15 @@ package body Trans.Chap3 is
 
       Push_Identifier_Prefix (Mark, Get_Identifier (Decl));
 
-      Def := Get_Type (Decl);
+      Ind := Get_Subtype_Indication (Decl);
+
+      --  Object subtype indication (if a proper one).
+      if Ind /= Null_Iir and then Is_Proper_Subtype_Indication (Ind) then
+         Ind_Type := Get_Type_Of_Subtype_Indication (Ind);
+         Push_Identifier_Prefix (Mark2, "OT");
+         Chap3.Translate_Subtype_Definition (Ind_Type, With_Vars);
+         Pop_Identifier_Prefix (Mark2);
+      end if;
 
       --  2) Constants may have a type that is different from the subtype
       --     indication, when the subtype indication is not fully constrained.
@@ -2730,45 +2739,43 @@ package body Trans.Chap3 is
       --     add some constraints on the type mark and the initial value add
       --     even more constraints.
       if Get_Kind (Decl) = Iir_Kind_Constant_Declaration then
-         Ind := Get_Subtype_Indication (Decl);
-         Ind := Get_Type_Of_Subtype_Indication (Ind);
-         if Ind /= Def then
-            Push_Identifier_Prefix (Mark2, "OTI");
-            Chap3.Translate_Subtype_Definition (Ind, With_Vars);
+         Ind_Type := Get_Type_Of_Subtype_Indication (Ind);
+         Def := Get_Type (Decl);
+         if Def /= Ind_Type then
+            Push_Identifier_Prefix (Mark2, "OTD");
+            Chap3.Translate_Subtype_Definition (Def, With_Vars);
             Pop_Identifier_Prefix (Mark2);
          end if;
       end if;
 
-      Push_Identifier_Prefix (Mark2, "OT");
-      Chap3.Translate_Subtype_Definition (Def, With_Vars);
-      Pop_Identifier_Prefix (Mark2);
-
       Pop_Identifier_Prefix (Mark);
    end Translate_Object_Subtype_Indication;
 
    procedure Elab_Object_Subtype_Indication (Decl : Iir)
    is
-      Def : constant Iir := Get_Type (Decl);
+      Ind : Iir;
+      Ind_Type : Iir;
+      Def : Iir;
    begin
-      if not Is_Anonymous_Type_Definition (Def) then
-         --  The type refers to a declared type, so already handled.
+      --  See translate_Object_Subtype_Indication.
+      if Get_Is_Ref (Decl) then
          return;
       end if;
 
-      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
+      Ind := Get_Subtype_Indication (Decl);
+
+      if Ind /= Null_Iir and then Is_Proper_Subtype_Indication (Ind) then
+         Ind_Type := Get_Type_Of_Subtype_Indication (Ind);
+         Elab_Subtype_Definition (Ind_Type);
+      end if;
+
+      if Get_Kind (Decl) = Iir_Kind_Constant_Declaration then
+         Ind_Type := Get_Type_Of_Subtype_Indication (Ind);
+         Def := Get_Type (Decl);
+         if Def /= Ind_Type then
             Elab_Subtype_Definition (Def);
          end if;
-      end;
+      end if;
    end Elab_Object_Subtype_Indication;
 
    procedure Elab_Type_Declaration (Decl : Iir) is
diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb
index 198bcbe62..b0ea8fae3 100644
--- a/src/vhdl/translate/trans-chap4.adb
+++ b/src/vhdl/translate/trans-chap4.adb
@@ -193,7 +193,10 @@ package body Trans.Chap4 is
       Type_Info    : Type_Info_Acc;
       Info         : Signal_Info_Acc;
    begin
-      Chap3.Translate_Object_Subtype_Indication (Decl);
+      if Get_Kind (Decl) /= Iir_Kind_Guard_Signal_Declaration then
+         --  No subtype indication for guard signals (and its type is boolean).
+         Chap3.Translate_Object_Subtype_Indication (Decl);
+      end if;
 
       Type_Info := Get_Info (Sig_Type_Def);
       Info := Add_Info (Decl, Kind_Signal);
@@ -730,6 +733,7 @@ package body Trans.Chap4 is
 
          if Get_Info (Obj).Object_Static then
             --  A static object is pre-initialized.
+            Chap3.Elab_Object_Subtype_Indication (Obj);
             return;
          end if;
 
@@ -1698,6 +1702,23 @@ package body Trans.Chap4 is
          Info.Alias_Kind := Mode_Value;
       end if;
 
+      if Get_Kind (Name) = Iir_Kind_Slice_Name then
+         --  The name subtype will be evaluated once at elaboration, as it is
+         --  needed when direct drivers are used (in that case, the name is
+         --  evaluated once again).
+         --  FIXME: only when the subtype indication is not set ?
+         declare
+            Name_Type : constant Iir := Get_Type (Name);
+            Mark1, Mark2 : Id_Mark_Type;
+         begin
+            Push_Identifier_Prefix (Mark1, Get_Identifier (Decl));
+            Push_Identifier_Prefix (Mark2, "AT");
+            Chap3.Translate_Array_Subtype (Name_Type);
+            Pop_Identifier_Prefix (Mark2);
+            Pop_Identifier_Prefix (Mark1);
+         end;
+      end if;
+
       Tinfo := Get_Info (Decl_Type);
       for Mode in Mode_Value .. Info.Alias_Kind loop
          case Tinfo.Type_Mode is
@@ -1731,24 +1752,6 @@ package body Trans.Chap4 is
          end if;
          Info.Alias_Var (Mode) := Create_Var (Id, Atype);
       end loop;
-
-      if Get_Kind (Name) = Iir_Kind_Slice_Name
-        and then Info.Alias_Kind = Mode_Signal
-      then
-         --  The name subtype will be evaluated once at elaboration, as it is
-         --  needed when direct drivers are used (in that case, the name is
-         --  evaluated once again).
-         declare
-            Name_Type : constant Iir := Get_Type (Name);
-            Mark1, Mark2 : Id_Mark_Type;
-         begin
-            Push_Identifier_Prefix (Mark1, Get_Identifier (Decl));
-            Push_Identifier_Prefix (Mark2, "AT");
-            Chap3.Translate_Array_Subtype (Name_Type);
-            Pop_Identifier_Prefix (Mark2);
-            Pop_Identifier_Prefix (Mark1);
-         end;
-      end if;
    end Translate_Object_Alias_Declaration;
 
    procedure Elab_Object_Alias_Declaration
@@ -1767,9 +1770,7 @@ package body Trans.Chap4 is
 
       Open_Temp;
 
-      if Get_Kind (Name) = Iir_Kind_Slice_Name
-        and then Alias_Info.Alias_Kind = Mode_Signal
-      then
+      if Get_Kind (Name) = Iir_Kind_Slice_Name then
          --  See Translate_Object_Alias_Declaration.
          Chap3.Elab_Array_Subtype (Name_Type);
       end if;
diff --git a/src/vhdl/vhdl-utils.adb b/src/vhdl/vhdl-utils.adb
index 04fab38a9..fa5f31ee8 100644
--- a/src/vhdl/vhdl-utils.adb
+++ b/src/vhdl/vhdl-utils.adb
@@ -1323,7 +1323,21 @@ package body Vhdl.Utils is
       end case;
    end Get_Nature_Of_Subnature_Indication;
 
-   function Is_Owned_Subtype_Indication (Decl : Iir) return Boolean
+   function Is_Proper_Subtype_Indication (Def : Iir) return Boolean is
+   begin
+      case Get_Kind (Def) is
+         when Iir_Kinds_Subtype_Definition =>
+            return True;
+         when Iir_Kinds_Denoting_Name
+           | Iir_Kind_Element_Attribute
+           | Iir_Kind_Subtype_Attribute =>
+            return False;
+         when others =>
+            Error_Kind ("is_proper_subtype_indication", Def);
+      end case;
+   end Is_Proper_Subtype_Indication;
+
+   function Has_Owned_Subtype_Indication (Decl : Iir) return Boolean
    is
       Def : Iir;
    begin
@@ -1341,17 +1355,8 @@ package body Vhdl.Utils is
          return False;
       end if;
 
-      case Get_Kind (Def) is
-         when Iir_Kinds_Subtype_Definition =>
-            return True;
-         when Iir_Kinds_Denoting_Name
-           | Iir_Kind_Element_Attribute
-           | Iir_Kind_Subtype_Attribute =>
-            return False;
-         when others =>
-            Error_Kind ("is_owned_subtype_indication", Def);
-      end case;
-   end Is_Owned_Subtype_Indication;
+      return Is_Proper_Subtype_Indication (Def);
+   end Has_Owned_Subtype_Indication;
 
    function Get_Index_Type (Indexes : Iir_Flist; Idx : Natural) return Iir
    is
diff --git a/src/vhdl/vhdl-utils.ads b/src/vhdl/vhdl-utils.ads
index 5cdef0daa..8dba4e221 100644
--- a/src/vhdl/vhdl-utils.ads
+++ b/src/vhdl/vhdl-utils.ads
@@ -258,9 +258,13 @@ package Vhdl.Utils is
    --  skip over denoting names.
    function Get_Type_Of_Subtype_Indication (Ind : Iir) return Iir;
 
+   --  Return True iff DEF defines a new subtype indication, not just an
+   --  existing name (like a name).
+   function Is_Proper_Subtype_Indication (Def : Iir) return Boolean;
+
    --  Return True iff the subtype indication of DECL is defined/owned by
    --  DECL.
-   function Is_Owned_Subtype_Indication (Decl : Iir) return Boolean;
+   function Has_Owned_Subtype_Indication (Decl : Iir) return Boolean;
 
    --  Get the type of an index_subtype_definition or of a discrete_range from
    --  an index_constraint.