Consider object for array attribute.

Fix issue #151

4 files changed, 51 insertions, 35 deletions

diff --git a/src/vhdl/evaluation.adb b/src/vhdl/evaluation.adb
index 06b8b5537..9c5f4cf3c 100644
--- a/src/vhdl/evaluation.adb
+++ b/src/vhdl/evaluation.adb
@@ -1488,7 +1488,8 @@ package body Evaluation is
            | Iir_Kind_Type_Declaration
            | Iir_Kind_Implicit_Dereference
            | Iir_Kind_Function_Call
-           | Iir_Kind_Attribute_Value =>
+           | Iir_Kind_Attribute_Value
+           | Iir_Kind_Attribute_Name =>
             Prefix_Type := Get_Type (Prefix);
          when Iir_Kinds_Subtype_Definition =>
             Prefix_Type := Prefix;
diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb
index 777965cd0..6441e789a 100644
--- a/src/vhdl/iirs_utils.adb
+++ b/src/vhdl/iirs_utils.adb
@@ -1174,21 +1174,21 @@ package body Iirs_Utils is
    function Create_Array_Subtype (Arr_Type : Iir; Loc : Location_Type)
      return Iir_Array_Subtype_Definition
    is
+      Base_Type : constant Iir := Get_Base_Type (Arr_Type);
+      El_Type : constant Iir := Get_Element_Subtype (Base_Type);
       Res : Iir_Array_Subtype_Definition;
-      Base_Type : Iir;
       List : Iir_List;
    begin
       Res := Create_Iir (Iir_Kind_Array_Subtype_Definition);
       Set_Location (Res, Loc);
-      Base_Type := Get_Base_Type (Arr_Type);
       Set_Base_Type (Res, Base_Type);
-      Set_Element_Subtype (Res, Get_Element_Subtype (Base_Type));
+      Set_Element_Subtype (Res, El_Type);
       if Get_Kind (Arr_Type) = Iir_Kind_Array_Subtype_Definition then
          Set_Resolution_Indication (Res, Get_Resolution_Indication (Arr_Type));
       end if;
       Set_Resolved_Flag (Res, Get_Resolved_Flag (Arr_Type));
       Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Arr_Type));
-      Set_Type_Staticness (Res, Get_Type_Staticness (Base_Type));
+      Set_Type_Staticness (Res, Get_Type_Staticness (El_Type));
       List := Create_Iir_List;
       Set_Index_Subtype_List (Res, List);
       Set_Index_Constraint_List (Res, List);
diff --git a/src/vhdl/sem_decls.adb b/src/vhdl/sem_decls.adb
index 2d2dce858..7d83c2e13 100644
--- a/src/vhdl/sem_decls.adb
+++ b/src/vhdl/sem_decls.adb
@@ -116,25 +116,6 @@ package body Sem_Decls is
       end if;
    end Check_Signal_Type;
 
-   --  Create a globally static subtype.
-   procedure Sem_Force_Static_Type (Decl : Iir; Atype : Iir)
-   is
-      Base_Type : constant Iir := Get_Base_Type (Atype);
-      Res : Iir;
-   begin
-      pragma Assert (Get_Kind (Base_Type) = Iir_Kind_Array_Type_Definition);
-      Res := Create_Iir (Iir_Kind_Array_Subtype_Definition);
-      Set_Location (Res, Get_Location (Decl));
-      Set_Element_Subtype (Res, Get_Element_Subtype (Atype));
-      Set_Base_Type (Res, Base_Type);
-      Set_Index_Subtype_List (Res, Get_Index_Subtype_List (Atype));
-      Set_Type_Staticness (Res, Globally);
-      Set_Constraint_State (Res, Get_Constraint_State (Atype));
-      Set_Index_Constraint_Flag (Res, Get_Index_Constraint_Flag (Atype));
-      Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Atype));
-      Set_Type (Decl, Res);
-   end Sem_Force_Static_Type;
-
    procedure Sem_Interface_Object_Declaration
      (Inter, Last : Iir; Interface_Kind : Interface_Kind_Type)
    is
@@ -313,14 +294,6 @@ package body Sem_Decls is
                --   LRM93 7.4.2 (Globally static primaries)
                --   3. a generic constant.
                Set_Expr_Staticness (Inter, Globally);
-
-               if A_Type /= Null_Iir
-                 and then (Get_Kind (A_Type)
-                             in Iir_Kinds_Composite_Type_Definition)
-                 and then Get_Type_Staticness (A_Type) = None
-               then
-                  Sem_Force_Static_Type (Inter, A_Type);
-               end if;
             end if;
          when Port_Interface_List =>
             if Get_Kind (Inter) /= Iir_Kind_Interface_Signal_Declaration then
@@ -1725,8 +1698,6 @@ package body Sem_Decls is
       then
          if Get_Type_Staticness (Value_Type) >= Globally then
             Set_Type (Decl, Value_Type);
-         else
-            Sem_Force_Static_Type (Decl, Value_Type);
          end if;
       end if;
    end Sem_Object_Type_From_Value;
diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb
index 6fe3f47d9..1d2865f15 100644
--- a/src/vhdl/sem_names.adb
+++ b/src/vhdl/sem_names.adb
@@ -906,6 +906,44 @@ package body Sem_Names is
       return Res;
    end Sem_Type_Mark;
 
+   function Get_Object_Type_Staticness (Name : Iir) return Iir_Staticness
+   is
+      Base : constant Iir := Get_Base_Name (Name);
+      Parent : Iir;
+   begin
+      if Get_Kind (Base) in Iir_Kinds_Dereference then
+         return None;
+      end if;
+
+      Parent := Get_Parent (Base);
+      loop
+         case Get_Kind (Parent) is
+            when Iir_Kind_Entity_Declaration
+              | Iir_Kind_Architecture_Body
+              | Iir_Kind_Block_Statement
+              | Iir_Kind_Block_Header
+              | Iir_Kinds_Process_Statement
+              | Iir_Kind_Generate_Statement_Body
+              | Iir_Kind_Design_Unit =>
+               --  Globally static.
+               return Globally;
+            when Iir_Kind_Package_Declaration
+              | Iir_Kind_Package_Body
+              | Iir_Kind_Package_Instantiation_Declaration
+              | Iir_Kind_Protected_Type_Body =>
+               --  Possibly nested construct.
+               Parent := Get_Parent (Parent);
+            when Iir_Kinds_Subprogram_Declaration
+              | Iir_Kinds_Subprogram_Body
+              | Iir_Kinds_Interface_Subprogram_Declaration =>
+               --  Not globally static.
+               return None;
+            when others =>
+               Error_Kind ("get_object_type_staticness", Parent);
+         end case;
+      end loop;
+   end Get_Object_Type_Staticness;
+
    procedure Finish_Sem_Array_Attribute
      (Attr_Name : Iir; Attr : Iir; Param : Iir)
    is
@@ -914,6 +952,7 @@ package body Sem_Names is
       Index_Type : Iir;
       Prefix : Iir;
       Prefix_Name : Iir;
+      Staticness : Iir_Staticness;
    begin
       --  LRM93 14.1
       --  Parameter: A locally static expression of type universal_integer, the
@@ -1021,7 +1060,12 @@ package body Sem_Names is
       --  formed by imposing on an unconstrained array type a globally static
       --  index constraint.
 
-      Set_Expr_Staticness (Attr, Get_Type_Staticness (Prefix_Type));
+      Staticness := Get_Type_Staticness (Prefix_Type);
+      if Is_Object_Name (Prefix) then
+         Staticness := Iir_Staticness'Max
+           (Staticness, Get_Object_Type_Staticness (Prefix));
+      end if;
+      Set_Expr_Staticness (Attr, Staticness);
    end Finish_Sem_Array_Attribute;
 
    procedure Finish_Sem_Scalar_Type_Attribute