diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/errorout.ads | 5 | ||||
| -rw-r--r-- | src/vhdl/vhdl-sem_names.adb | 6 | ||||
| -rw-r--r-- | src/vhdl/vhdl-utils.adb | 37 |
3 files changed, 33 insertions, 15 deletions
diff --git a/src/errorout.ads b/src/errorout.ads index 0ec341514..763a8344b 100644 --- a/src/errorout.ads +++ b/src/errorout.ads @@ -108,6 +108,9 @@ package Errorout is -- Assertion during analysis. Warnid_Analyze_Assert, + -- Incorrect use of attributes (like non-object prefix). + Warnid_Attribute, + -- Violation of staticness rules Warnid_Static, @@ -298,7 +301,7 @@ private Default_Warnings : constant Warnings_Setting := (Warnid_Library | Warnid_Binding | Warnid_Port | Warnid_Shared | Warnid_Runtime_Error | Warnid_Pure | Warnid_Specs | Warnid_Hide - | Warnid_Pragma | Warnid_Analyze_Assert + | Warnid_Pragma | Warnid_Analyze_Assert | Warnid_Attribute | Msgid_Warning => (Enabled => True, Error => False), others => (Enabled => False, Error => False)); diff --git a/src/vhdl/vhdl-sem_names.adb b/src/vhdl/vhdl-sem_names.adb index b02fdedd4..ebed95997 100644 --- a/src/vhdl/vhdl-sem_names.adb +++ b/src/vhdl/vhdl-sem_names.adb @@ -962,6 +962,7 @@ package body Vhdl.Sem_Names is Parent : Iir; begin if Get_Kind (Base) in Iir_Kinds_Dereference then + -- A dereferenced object is never static. return None; end if; @@ -1039,6 +1040,11 @@ package body Vhdl.Sem_Names is then Prefix := Function_Declaration_To_Call (Prefix); end if; + if not Is_Object_Name (Prefix) then + Error_Msg_Sem_Relaxed + (Attr, Warnid_Attribute, + "prefix of array attribute must be an object name"); + end if; end if; Set_Prefix (Attr, Prefix); diff --git a/src/vhdl/vhdl-utils.adb b/src/vhdl/vhdl-utils.adb index d11b17a2b..421bf4474 100644 --- a/src/vhdl/vhdl-utils.adb +++ b/src/vhdl/vhdl-utils.adb @@ -393,6 +393,10 @@ package body Vhdl.Utils is when Iir_Kind_Slice_Name | Iir_Kind_Indexed_Name | Iir_Kind_Selected_Element => + if Name_To_Object (Get_Prefix (Name)) = Null_Iir then + -- The prefix may not be an object. + return Null_Iir; + end if; return Name; -- An object designated by a value of an access type @@ -1034,20 +1038,25 @@ package body Vhdl.Utils is is Ent : Iir; begin - if Get_Kind (Name) in Iir_Kinds_Denoting_Name then - Ent := Get_Named_Entity (Name); - case Get_Kind (Ent) is - when Iir_Kind_Type_Declaration => - return Get_Type_Definition (Ent); - when Iir_Kind_Subtype_Declaration - | Iir_Kind_Base_Attribute => - return Get_Type (Ent); - when others => - return Null_Iir; - end case; - else - return Null_Iir; - end if; + case Get_Kind (Name) is + when Iir_Kinds_Denoting_Name + | Iir_Kind_Attribute_Name => + Ent := Get_Named_Entity (Name); + case Get_Kind (Ent) is + when Iir_Kind_Type_Declaration => + return Get_Type_Definition (Ent); + when Iir_Kind_Subtype_Declaration + | Iir_Kind_Base_Attribute + | Iir_Kind_Subtype_Attribute => + return Get_Type (Ent); + when others => + return Null_Iir; + end case; + when Iir_Kind_Subtype_Attribute => + return Get_Type (Ent); + when others => + return Null_Iir; + end case; end Is_Type_Name; function Get_Type_Of_Subtype_Indication (Ind : Iir) return Iir is |