vhdl08: implement 'subtype attribute

Fix #253

10 files changed, 201 insertions, 74 deletions

diff --git a/src/std_names.adb b/src/std_names.adb
index 8993caf17..96bbc543e 100644
--- a/src/std_names.adb
+++ b/src/std_names.adb
@@ -226,6 +226,8 @@ package body Std_Names is
       Def ("instance_name", Name_Instance_Name);
       Def ("path_name",     Name_Path_Name);
 
+      Def ("element",       Name_Element);
+
       Def ("contribution",  Name_Contribution);
       Def ("dot",           Name_Dot);
       Def ("integ",         Name_Integ);
diff --git a/src/std_names.ads b/src/std_names.ads
index a5566b0c7..b54dcb693 100644
--- a/src/std_names.ads
+++ b/src/std_names.ads
@@ -259,7 +259,7 @@ package Std_Names is
    Name_Last_Attribute : constant Name_Id := Name_Last_Value;
 
    subtype Name_Id_Attributes is Name_Id
-     range Name_First_Attribute ..Name_Last_Attribute;
+     range Name_First_Attribute .. Name_Last_Attribute;
 
    Name_First_Vhdl87_Attribute : constant Name_Id := Name_Last_Value + 1;
    Name_Behavior :       constant Name_Id := Name_First_Attribute + 022;
@@ -267,7 +267,7 @@ package Std_Names is
    Name_Last_Vhdl87_Attribute : constant Name_Id := Name_Structure;
 
    subtype Name_Id_Vhdl87_Attributes is Name_Id
-     range Name_First_Vhdl87_Attribute ..Name_Last_Vhdl87_Attribute;
+     range Name_First_Vhdl87_Attribute .. Name_Last_Vhdl87_Attribute;
 
    Name_First_Vhdl93_Attribute : constant Name_Id := Name_Structure + 1;
    Name_Ascending :      constant Name_Id := Name_First_Attribute + 024;
@@ -281,10 +281,16 @@ package Std_Names is
    Name_Last_Vhdl93_Attribute : constant Name_Id := Name_Path_Name;
 
    subtype Name_Id_Vhdl93_Attributes is Name_Id
-     range Name_First_Vhdl93_Attribute ..Name_Last_Vhdl93_Attribute;
+     range Name_First_Vhdl93_Attribute .. Name_Last_Vhdl93_Attribute;
+
+   Name_First_Vhdl08_Attribute : constant Name_Id :=
+                                             Name_Last_Vhdl93_Attribute + 01;
+   Name_Element :        constant Name_Id := Name_First_Vhdl08_Attribute + 00;
+   Name_Last_Vhdl08_Attribute :  constant Name_Id :=
+                                             Name_First_Vhdl08_Attribute + 00;
 
    Name_First_AMS_Attribute : constant Name_Id :=
-     Name_Last_Vhdl93_Attribute + 1;
+     Name_Last_Vhdl08_Attribute + 1;
    Name_Contribution :   constant Name_Id := Name_First_AMS_Attribute + 000;
    Name_Dot :            constant Name_Id := Name_First_AMS_Attribute + 001;
    Name_Integ :          constant Name_Id := Name_First_AMS_Attribute + 002;
diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb
index 00a737c44..60e77871a 100644
--- a/src/vhdl/errorout.adb
+++ b/src/vhdl/errorout.adb
@@ -1073,6 +1073,10 @@ package body Errorout is
             return "'range attribute";
          when Iir_Kind_Reverse_Range_Array_Attribute =>
             return "'reverse_range attribute";
+         when Iir_Kind_Subtype_Attribute =>
+            return "'subtype attribute";
+         when Iir_Kind_Element_Attribute =>
+            return "'element attribute";
          when Iir_Kind_Ascending_Type_Attribute
            | Iir_Kind_Ascending_Array_Attribute =>
             return "'ascending attribute";
diff --git a/src/vhdl/evaluation.adb b/src/vhdl/evaluation.adb
index c09cac7d0..14e3d97db 100644
--- a/src/vhdl/evaluation.adb
+++ b/src/vhdl/evaluation.adb
@@ -3353,7 +3353,9 @@ package body Evaluation is
                end;
 
             when Iir_Kind_Subtype_Declaration
-              | Iir_Kind_Base_Attribute =>
+              | Iir_Kind_Base_Attribute
+              | Iir_Kind_Subtype_Attribute
+              | Iir_Kind_Element_Attribute =>
                Expr := Get_Type (Expr);
             when Iir_Kind_Type_Declaration =>
                Expr := Get_Type_Definition (Expr);
diff --git a/src/vhdl/iirs.adb b/src/vhdl/iirs.adb
index fe2b20624..f4e30ba30 100644
--- a/src/vhdl/iirs.adb
+++ b/src/vhdl/iirs.adb
@@ -433,6 +433,8 @@ package body Iirs is
            | Iir_Kind_Relative_Pathname
            | Iir_Kind_Pathname_Element
            | Iir_Kind_Base_Attribute
+           | Iir_Kind_Subtype_Attribute
+           | Iir_Kind_Element_Attribute
            | Iir_Kind_Left_Type_Attribute
            | Iir_Kind_Right_Type_Attribute
            | Iir_Kind_High_Type_Attribute
diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads
index f313191fb..cc3237398 100644
--- a/src/vhdl/iirs.ads
+++ b/src/vhdl/iirs.ads
@@ -3835,6 +3835,7 @@ package Iirs is
    --
    --   Get/Set_Type (Field1)
    --
+   --  Set only when known to be constrained.
    --   Get/Set_Index_Subtype (Field2)
    --
    --   Get/Set_Parameter (Field4)
@@ -3845,6 +3846,19 @@ package Iirs is
    --
    --   Get/Set_Name_Staticness (State2)
 
+   -- Iir_Kind_Subtype_Attribute (Short)
+   -- Iir_Kind_Element_Attribute (Short)
+   --
+   --   Get/Set_Prefix (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Base_Name (Field5)
+   --
+   --   Get/Set_Type_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
    -- Iir_Kind_Stable_Attribute (Short)
    -- Iir_Kind_Delayed_Attribute (Short)
    -- Iir_Kind_Quiet_Attribute (Short)
@@ -4240,6 +4254,8 @@ package Iirs is
 
    -- Attributes
       Iir_Kind_Base_Attribute,
+      Iir_Kind_Subtype_Attribute,
+      Iir_Kind_Element_Attribute,
       Iir_Kind_Left_Type_Attribute,            --  type_attribute
       Iir_Kind_Right_Type_Attribute,           --  type_attribute
       Iir_Kind_High_Type_Attribute,            --  type_attribute
@@ -5148,6 +5164,7 @@ package Iirs is
      Iir_Kind_Base_Attribute ..
      Iir_Kind_Reverse_Range_Array_Attribute;
 
+   --  Attributes of a scalar type.
    subtype Iir_Kinds_Type_Attribute is Iir_Kind range
      Iir_Kind_Left_Type_Attribute ..
    --Iir_Kind_Right_Type_Attribute
@@ -5155,6 +5172,12 @@ package Iirs is
    --Iir_Kind_Low_Type_Attribute
      Iir_Kind_Ascending_Type_Attribute;
 
+   --  Attributes whose result is a type.
+   subtype Iir_Kinds_Subtype_Attribute is Iir_Kind range
+     Iir_Kind_Base_Attribute ..
+   --Iir_Kind_Subtype_Attribute
+     Iir_Kind_Element_Attribute;
+
    subtype Iir_Kinds_Scalar_Type_Attribute is Iir_Kind range
      Iir_Kind_Pos_Attribute ..
    --Iir_Kind_Val_Attribute
@@ -6444,7 +6467,9 @@ package Iirs is
    procedure Set_Constraint_State (Atype : Iir; State : Iir_Constraint);
 
    --  Reference either index_subtype_definition_list of array_type_definition
-   --  or index_constraint_list of array_subtype_definition.
+   --  or index_constraint_list of array_subtype_definition.  Set only when
+   --  the index_sutype is constrained (to differentiate with unconstrained
+   --  index type).
    --  Field: Field9 Ref (uc)
    function Get_Index_Subtype_List (Decl : Iir) return Iir_List;
    procedure Set_Index_Subtype_List (Decl : Iir; List : Iir_List);
diff --git a/src/vhdl/nodes_meta.adb b/src/vhdl/nodes_meta.adb
index 385c1261c..67b2290dd 100644
--- a/src/vhdl/nodes_meta.adb
+++ b/src/vhdl/nodes_meta.adb
@@ -1457,6 +1457,10 @@ package body Nodes_Meta is
             return "pathname_element";
          when Iir_Kind_Base_Attribute =>
             return "base_attribute";
+         when Iir_Kind_Subtype_Attribute =>
+            return "subtype_attribute";
+         when Iir_Kind_Element_Attribute =>
+            return "element_attribute";
          when Iir_Kind_Left_Type_Attribute =>
             return "left_type_attribute";
          when Iir_Kind_Right_Type_Attribute =>
@@ -4065,6 +4069,18 @@ package body Nodes_Meta is
       --  Iir_Kind_Base_Attribute
       Field_Prefix,
       Field_Type,
+      --  Iir_Kind_Subtype_Attribute
+      Field_Type_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Element_Attribute
+      Field_Type_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Type,
+      Field_Base_Name,
       --  Iir_Kind_Left_Type_Attribute
       Field_Expr_Staticness,
       Field_Name_Staticness,
@@ -4554,44 +4570,46 @@ package body Nodes_Meta is
       Iir_Kind_Relative_Pathname => 1641,
       Iir_Kind_Pathname_Element => 1646,
       Iir_Kind_Base_Attribute => 1648,
-      Iir_Kind_Left_Type_Attribute => 1653,
-      Iir_Kind_Right_Type_Attribute => 1658,
-      Iir_Kind_High_Type_Attribute => 1663,
-      Iir_Kind_Low_Type_Attribute => 1668,
-      Iir_Kind_Ascending_Type_Attribute => 1673,
-      Iir_Kind_Image_Attribute => 1679,
-      Iir_Kind_Value_Attribute => 1685,
-      Iir_Kind_Pos_Attribute => 1691,
-      Iir_Kind_Val_Attribute => 1697,
-      Iir_Kind_Succ_Attribute => 1703,
-      Iir_Kind_Pred_Attribute => 1709,
-      Iir_Kind_Leftof_Attribute => 1715,
-      Iir_Kind_Rightof_Attribute => 1721,
-      Iir_Kind_Delayed_Attribute => 1730,
-      Iir_Kind_Stable_Attribute => 1739,
-      Iir_Kind_Quiet_Attribute => 1748,
-      Iir_Kind_Transaction_Attribute => 1757,
-      Iir_Kind_Event_Attribute => 1761,
-      Iir_Kind_Active_Attribute => 1765,
-      Iir_Kind_Last_Event_Attribute => 1769,
-      Iir_Kind_Last_Active_Attribute => 1773,
-      Iir_Kind_Last_Value_Attribute => 1777,
-      Iir_Kind_Driving_Attribute => 1781,
-      Iir_Kind_Driving_Value_Attribute => 1785,
-      Iir_Kind_Behavior_Attribute => 1785,
-      Iir_Kind_Structure_Attribute => 1785,
-      Iir_Kind_Simple_Name_Attribute => 1792,
-      Iir_Kind_Instance_Name_Attribute => 1797,
-      Iir_Kind_Path_Name_Attribute => 1802,
-      Iir_Kind_Left_Array_Attribute => 1809,
-      Iir_Kind_Right_Array_Attribute => 1816,
-      Iir_Kind_High_Array_Attribute => 1823,
-      Iir_Kind_Low_Array_Attribute => 1830,
-      Iir_Kind_Length_Array_Attribute => 1837,
-      Iir_Kind_Ascending_Array_Attribute => 1844,
-      Iir_Kind_Range_Array_Attribute => 1851,
-      Iir_Kind_Reverse_Range_Array_Attribute => 1858,
-      Iir_Kind_Attribute_Name => 1867
+      Iir_Kind_Subtype_Attribute => 1653,
+      Iir_Kind_Element_Attribute => 1658,
+      Iir_Kind_Left_Type_Attribute => 1663,
+      Iir_Kind_Right_Type_Attribute => 1668,
+      Iir_Kind_High_Type_Attribute => 1673,
+      Iir_Kind_Low_Type_Attribute => 1678,
+      Iir_Kind_Ascending_Type_Attribute => 1683,
+      Iir_Kind_Image_Attribute => 1689,
+      Iir_Kind_Value_Attribute => 1695,
+      Iir_Kind_Pos_Attribute => 1701,
+      Iir_Kind_Val_Attribute => 1707,
+      Iir_Kind_Succ_Attribute => 1713,
+      Iir_Kind_Pred_Attribute => 1719,
+      Iir_Kind_Leftof_Attribute => 1725,
+      Iir_Kind_Rightof_Attribute => 1731,
+      Iir_Kind_Delayed_Attribute => 1740,
+      Iir_Kind_Stable_Attribute => 1749,
+      Iir_Kind_Quiet_Attribute => 1758,
+      Iir_Kind_Transaction_Attribute => 1767,
+      Iir_Kind_Event_Attribute => 1771,
+      Iir_Kind_Active_Attribute => 1775,
+      Iir_Kind_Last_Event_Attribute => 1779,
+      Iir_Kind_Last_Active_Attribute => 1783,
+      Iir_Kind_Last_Value_Attribute => 1787,
+      Iir_Kind_Driving_Attribute => 1791,
+      Iir_Kind_Driving_Value_Attribute => 1795,
+      Iir_Kind_Behavior_Attribute => 1795,
+      Iir_Kind_Structure_Attribute => 1795,
+      Iir_Kind_Simple_Name_Attribute => 1802,
+      Iir_Kind_Instance_Name_Attribute => 1807,
+      Iir_Kind_Path_Name_Attribute => 1812,
+      Iir_Kind_Left_Array_Attribute => 1819,
+      Iir_Kind_Right_Array_Attribute => 1826,
+      Iir_Kind_High_Array_Attribute => 1833,
+      Iir_Kind_Low_Array_Attribute => 1840,
+      Iir_Kind_Length_Array_Attribute => 1847,
+      Iir_Kind_Ascending_Array_Attribute => 1854,
+      Iir_Kind_Range_Array_Attribute => 1861,
+      Iir_Kind_Reverse_Range_Array_Attribute => 1868,
+      Iir_Kind_Attribute_Name => 1877
      );
 
    function Get_Fields (K : Iir_Kind) return Fields_Array
@@ -7328,6 +7346,8 @@ package body Nodes_Meta is
            | Iir_Kind_External_Signal_Name
            | Iir_Kind_External_Variable_Name
            | Iir_Kind_Base_Attribute
+           | Iir_Kind_Subtype_Attribute
+           | Iir_Kind_Element_Attribute
            | Iir_Kind_Left_Type_Attribute
            | Iir_Kind_Right_Type_Attribute
            | Iir_Kind_High_Type_Attribute
@@ -7497,6 +7517,8 @@ package body Nodes_Meta is
            | Iir_Kind_Selected_Name
            | Iir_Kind_Operator_Symbol
            | Iir_Kind_Selected_By_All_Name
+           | Iir_Kind_Subtype_Attribute
+           | Iir_Kind_Element_Attribute
            | Iir_Kind_Left_Type_Attribute
            | Iir_Kind_Right_Type_Attribute
            | Iir_Kind_High_Type_Attribute
@@ -8284,7 +8306,9 @@ package body Nodes_Meta is
            | Iir_Kind_Integer_Type_Definition
            | Iir_Kind_Floating_Type_Definition
            | Iir_Kind_Physical_Type_Definition
-           | Iir_Kind_Wildcard_Type_Definition =>
+           | Iir_Kind_Wildcard_Type_Definition
+           | Iir_Kind_Subtype_Attribute
+           | Iir_Kind_Element_Attribute =>
             return True;
          when others =>
             return False;
@@ -9574,6 +9598,8 @@ package body Nodes_Meta is
            | Iir_Kind_External_Constant_Name
            | Iir_Kind_External_Signal_Name
            | Iir_Kind_External_Variable_Name
+           | Iir_Kind_Subtype_Attribute
+           | Iir_Kind_Element_Attribute
            | Iir_Kind_Left_Type_Attribute
            | Iir_Kind_Right_Type_Attribute
            | Iir_Kind_High_Type_Attribute
@@ -9630,6 +9656,8 @@ package body Nodes_Meta is
            | Iir_Kind_Selected_By_All_Name
            | Iir_Kind_Parenthesis_Name
            | Iir_Kind_Base_Attribute
+           | Iir_Kind_Subtype_Attribute
+           | Iir_Kind_Element_Attribute
            | Iir_Kind_Left_Type_Attribute
            | Iir_Kind_Right_Type_Attribute
            | Iir_Kind_High_Type_Attribute
diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb
index 2dc07d326..3adf845e2 100644
--- a/src/vhdl/parse.adb
+++ b/src/vhdl/parse.adb
@@ -747,8 +747,11 @@ package body Parse is
                   return Res;
                elsif Current_Token /= Tok_Range
                  and then Current_Token /= Tok_Identifier
+                 and then not (Vhdl_Std >= Vhdl_08
+                                 and then Current_Token = Tok_Subtype)
                then
-                  Expect (Tok_Identifier, "required for an attribute name");
+                  Expect
+                    (Tok_Identifier, "attribute identifier expected after '");
                   return Null_Iir;
                end if;
                Res := Create_Iir (Iir_Kind_Attribute_Name);
diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb
index 76dce228f..cdce11b4c 100644
--- a/src/vhdl/sem_names.adb
+++ b/src/vhdl/sem_names.adb
@@ -879,30 +879,35 @@ package body Sem_Names is
       end if;
       Res := Finish_Sem_Name (Name);
 
-      if Get_Kind (Res) in Iir_Kinds_Denoting_Name then
-         --  Common correct case.
-         Atype := Get_Named_Entity (Res);
-         case Get_Kind (Atype) is
-            when Iir_Kind_Type_Declaration =>
-               Atype := Get_Type_Definition (Atype);
-            when Iir_Kind_Subtype_Declaration
-              | Iir_Kind_Interface_Type_Declaration =>
-               Atype := Get_Type (Atype);
-            when others =>
+      case Get_Kind (Res) is
+         when Iir_Kinds_Denoting_Name =>
+            --  Common correct case.
+            Atype := Get_Named_Entity (Res);
+            case Get_Kind (Atype) is
+               when Iir_Kind_Type_Declaration =>
+                  Atype := Get_Type_Definition (Atype);
+               when Iir_Kind_Subtype_Declaration
+                 | Iir_Kind_Interface_Type_Declaration
+                 | Iir_Kind_Subtype_Attribute =>
+                  Atype := Get_Type (Atype);
+               when others =>
+                  Error_Msg_Sem
+                    (+Name, "a type mark must denote a type or a subtype");
+                  Atype := Create_Error_Type (Atype);
+                  Set_Named_Entity (Res, Atype);
+            end case;
+         when Iir_Kind_Subtype_Attribute
+           | Iir_Kind_Element_Attribute =>
+            Atype := Get_Type (Res);
+         when others =>
+            if Get_Kind (Res) /= Iir_Kind_Error then
                Error_Msg_Sem
-                 (+Name, "a type mark must denote a type or a subtype");
-               Atype := Create_Error_Type (Atype);
-               Set_Named_Entity (Res, Atype);
-         end case;
-      else
-         if Get_Kind (Res) /= Iir_Kind_Error then
-            Error_Msg_Sem
-              (+Name, "a type mark must be a simple or expanded name");
-         end if;
-         Res := Name;
-         Atype := Create_Error_Type (Name);
-         Set_Named_Entity (Res, Atype);
-      end if;
+                 (+Name, "a type mark must be a simple or expanded name");
+            end if;
+            Res := Name;
+            Atype := Create_Error_Type (Name);
+            Set_Named_Entity (Res, Atype);
+      end case;
 
       if not Incomplete then
          if Get_Kind (Atype) = Iir_Kind_Incomplete_Type_Definition then
@@ -1111,7 +1116,7 @@ package body Sem_Names is
       if Get_Kind (Prefix) = Iir_Kind_Attribute_Name then
          Prefix := Finish_Sem_Name (Prefix);
          Set_Prefix (Attr, Prefix);
-         pragma Assert (Get_Kind (Prefix) = Iir_Kind_Base_Attribute);
+         pragma Assert (Get_Kind (Prefix) in Iir_Kinds_Subtype_Attribute);
       else
          Prefix := Sem_Type_Mark (Prefix);
       end if;
@@ -1690,6 +1695,9 @@ package body Sem_Names is
                Free_Parenthesis_Name (Name, Res);
             end if;
             return Res;
+         when Iir_Kind_Subtype_Attribute =>
+            Free_Iir (Name);
+            return Res;
          when Iir_Kinds_Signal_Value_Attribute =>
             null;
          when Iir_Kinds_Signal_Attribute =>
@@ -2892,7 +2900,9 @@ package body Sem_Names is
             Prefix_Type := Get_Type_Definition (Prefix);
          when Iir_Kind_Subtype_Declaration =>
             Prefix_Type := Get_Type (Prefix);
-         when Iir_Kind_Base_Attribute =>
+         when Iir_Kind_Base_Attribute
+           | Iir_Kind_Subtype_Attribute
+           | Iir_Kind_Element_Attribute =>
             Prefix_Type := Get_Type (Prefix);
          when others =>
             Error_Msg_Sem
@@ -3121,7 +3131,9 @@ package body Sem_Names is
             end case;
          when Iir_Kind_Subtype_Declaration
            | Iir_Kind_Type_Declaration
-           | Iir_Kind_Base_Attribute =>
+           | Iir_Kind_Base_Attribute
+           | Iir_Kind_Subtype_Attribute
+           | Iir_Kind_Element_Attribute =>
             Prefix_Type := Get_Type (Prefix);
             if not Is_Fully_Constrained_Type (Prefix_Type) then
                Error_Msg_Sem (+Attr, "prefix type is not constrained");
@@ -3193,6 +3205,38 @@ package body Sem_Names is
       return Res;
    end Sem_Array_Attribute_Name;
 
+   --  For 'Subtype
+   function Sem_Subtype_Attribute (Attr : Iir_Attribute_Name) return Iir
+   is
+      Prefix_Name : constant Iir := Get_Prefix (Attr);
+      Prefix : Iir;
+      Prefix_Type : Iir;
+      Res : Iir;
+   begin
+      Prefix := Get_Named_Entity (Prefix_Name);
+
+      --  LRM08 16.2 Predefined attributes
+      --  Prefix: Any prefix O that is appropriate for an object, or an alias
+      --  thereof
+      if Get_Kind (Prefix) not in Iir_Kinds_Object_Declaration then
+         Error_Msg_Sem (+Attr, "prefix must denote an object");
+         return Error_Mark;
+      end if;
+
+      Prefix_Type := Get_Type (Prefix);
+
+      Res := Create_Iir (Iir_Kind_Subtype_Attribute);
+      Location_Copy (Res, Attr);
+      Set_Prefix (Res, Prefix);
+      Set_Type (Res, Prefix_Type);
+
+      Set_Base_Name (Res, Get_Base_Name (Prefix_Name));
+      Set_Name_Staticness (Res, Get_Name_Staticness (Prefix));
+      Set_Type_Staticness (Res, Get_Type_Staticness (Prefix_Type));
+
+      return Res;
+   end Sem_Subtype_Attribute;
+
    function Sem_Signal_Signal_Attribute
      (Attr : Iir_Attribute_Name; Kind : Iir_Kind)
      return Iir
@@ -3624,6 +3668,13 @@ package body Sem_Names is
                Res := Sem_User_Attribute (Attr);
             end if;
 
+         when Name_Subtype =>
+            if Flags.Vhdl_Std >= Vhdl_08 then
+               Res := Sem_Subtype_Attribute (Attr);
+            else
+               Res := Sem_User_Attribute (Attr);
+            end if;
+
          when others =>
             Res := Sem_User_Attribute (Attr);
       end case;
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index ce503db71..478c76565 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -4304,9 +4304,13 @@ package body Trans.Chap7 is
       case Get_Kind (Arange) is
          when Iir_Kinds_Denoting_Name =>
             return Translate_Range (Get_Named_Entity (Arange), Range_Type);
-         when Iir_Kind_Subtype_Declaration =>
+         when Iir_Kind_Subtype_Attribute
+           | Iir_Kind_Subtype_Declaration =>
+            return Translate_Range (Get_Type (Arange), Range_Type);
+         when Iir_Kinds_Scalar_Subtype_Definition
+           | Iir_Kind_Enumeration_Type_Definition =>
             --  Must be a scalar subtype.  Range of types is static.
-            return Get_Var (Get_Info (Get_Type (Arange)).S.Range_Var);
+            return Get_Var (Get_Info (Arange).S.Range_Var);
          when Iir_Kind_Range_Array_Attribute =>
             return Chap14.Translate_Range_Array_Attribute (Arange);
          when Iir_Kind_Reverse_Range_Array_Attribute =>