vhdl/translate: add support for subtype attribute. For #641

Copy bounds from the object.

3 files changed, 55 insertions, 22 deletions

diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb
index 652087b92..928af48a0 100644
--- a/src/vhdl/translate/trans-chap3.adb
+++ b/src/vhdl/translate/trans-chap3.adb
@@ -2549,25 +2549,26 @@ package body Trans.Chap3 is
    is
       Def : constant Iir := Get_Type (Decl);
    begin
+      --  Note about subtype_indication and type in a declaration:
+      --  1) The subtype_indication is present only on the first declared
+      --     object when there is a list of identifiers.  This could be
+      --     changed by making the subtype_indication Maybe_Ref.
+      --  2) Constants may have a type that is different from the subtype
+      --     indication, when the subtype indication is not fully constrained.
+      --     TODO: explain why!
+      --  3) An object alias always have a type but may have no subtype
+      --     indication.  Maybe this should be handled separately.
+      --  4) An anonymous_signal_declaration has no subtype indication.
+      --  5) It is not possible to translate the type when the subtype
+      --     indication is a subtype_attribute.  So this is an exception
+      --     TODO: if there is a list of identifiers.
+
       if not Is_Anonymous_Type_Definition (Def) then
          --  The type refers to a declared type, so already handled.
          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
-            Translate_Object_Subtype_Definition (Decl, Def, With_Vars);
-         end if;
-      end;
+      Translate_Object_Subtype_Definition (Decl, Def, With_Vars);
    end Translate_Object_Subtype_Indication;
 
    procedure Elab_Object_Subtype_Indication (Decl : Iir)
diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb
index 9a98e79ee..94f389637 100644
--- a/src/vhdl/translate/trans-chap4.adb
+++ b/src/vhdl/translate/trans-chap4.adb
@@ -1067,6 +1067,37 @@ package body Trans.Chap4 is
       Update_Data_Record => Elab_Signal_Update_Record,
       Finish_Data_Record => Elab_Signal_Finish_Composite);
 
+   procedure Elab_Maybe_Subtype_Attribute
+     (Decl : Iir; Name_Val : Mnode; Name_Sig : Mnode)
+   is
+      Ind : Iir;
+      Name : Mnode;
+      Bnd : Mnode;
+   begin
+      case Get_Kind (Decl) is
+         when Iir_Kind_Anonymous_Signal_Declaration =>
+            return;
+         when others =>
+            Ind := Get_Subtype_Indication (Decl);
+            if Ind = Null_Iir
+              or else Get_Kind (Ind) /= Iir_Kind_Subtype_Attribute
+            then
+               return;
+            end if;
+      end case;
+
+      Name := Chap6.Translate_Name (Get_Prefix (Ind), Mode_Value);
+      Bnd := Chap3.Get_Composite_Bounds (Name);
+
+      if Name_Sig /= Mnode_Null then
+         Stabilize (Bnd);
+         New_Assign_Stmt (M2Lp (Chap3.Get_Composite_Bounds (Name_Sig)),
+                          M2Addr (Bnd));
+      end if;
+      New_Assign_Stmt (M2Lp (Chap3.Get_Composite_Bounds (Name_Val)),
+                       M2Addr (Bnd));
+   end Elab_Maybe_Subtype_Attribute;
+
    --  Elaborate signal subtypes and allocate the storage for the object.
    procedure Elab_Signal_Declaration_Storage (Decl : Iir; Has_Copy : Boolean)
    is
@@ -1088,10 +1119,6 @@ package body Trans.Chap4 is
       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);
@@ -1099,16 +1126,21 @@ package body Trans.Chap4 is
          else
             Chap6.Translate_Signal_Name (Decl, Name_Sig, Name_Val);
          end if;
-         Name_Sig := Stabilize (Name_Sig);
 
-         Chap3.Allocate_Unbounded_Composite_Base
-           (Alloc_System, Name_Sig, Sig_Type);
+         Name_Sig := Stabilize (Name_Sig);
 
          if Name_Val /= Mnode_Null then
             Name_Val := Stabilize (Name_Val);
+            Elab_Maybe_Subtype_Attribute (Decl, Name_Val, Name_Sig);
             Chap3.Allocate_Unbounded_Composite_Base
               (Alloc_System, Name_Val, Sig_Type);
+         else
+            Elab_Maybe_Subtype_Attribute (Decl, Name_Sig, Mnode_Null);
          end if;
+
+         Chap3.Allocate_Unbounded_Composite_Base
+           (Alloc_System, Name_Sig, Sig_Type);
+
          if Is_Port and then Get_Default_Value (Decl) /= Null_Iir then
             Name_Val := Chap6.Get_Port_Init_Value (Decl);
             Name_Val := Stabilize (Name_Val);
diff --git a/src/vhdl/vhdl-sem_names.adb b/src/vhdl/vhdl-sem_names.adb
index 9463b1b37..6e7d1e11d 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 not Is_Fully_Constrained_Type (Attr_Type) then
+      if False and not Is_Fully_Constrained_Type (Attr_Type) then
          Attr_Type := Sem_Types.Build_Constrained_Subtype (Attr_Type, Attr);
       end if;