diff options
| author | Tristan Gingold <tgingold@free.fr> | 2023-04-30 19:05:16 +0200 |
|---|---|---|
| committer | Tristan Gingold <tgingold@free.fr> | 2023-04-30 19:32:25 +0200 |
| commit | aeb15c6d168fd032689c85fdb42e2a4904bfbd6f (patch) | |
| tree | c990d6b271e7d78e84ab55b02dedb3f6dd52bfad | |
| parent | 7eae7370a101e4bb851394ce748f0fddf7fb3f2f (diff) | |
| download | ghdl-aeb15c6d168fd032689c85fdb42e2a4904bfbd6f.tar.gz ghdl-aeb15c6d168fd032689c85fdb42e2a4904bfbd6f.tar.bz2 ghdl-aeb15c6d168fd032689c85fdb42e2a4904bfbd6f.zip | |
vhdl-sem_specs: allow attribute specification on a type if -frelaxed
Fix #2427
| -rw-r--r-- | src/errorout.ads | 1 | ||||
| -rw-r--r-- | src/vhdl/vhdl-sem_specs.adb | 31 |
2 files changed, 22 insertions, 10 deletions
diff --git a/src/errorout.ads b/src/errorout.ads index d49ff5b5a..676c5b519 100644 --- a/src/errorout.ads +++ b/src/errorout.ads @@ -78,6 +78,7 @@ package Errorout is -- An all/others specification does not apply, because there is no such -- named entities. + -- Attribute specification of class type to an anonymous type. Warnid_Specs, -- Incorrect use of universal value. diff --git a/src/vhdl/vhdl-sem_specs.adb b/src/vhdl/vhdl-sem_specs.adb index dbc3e376c..9ff333a28 100644 --- a/src/vhdl/vhdl-sem_specs.adb +++ b/src/vhdl/vhdl-sem_specs.adb @@ -242,6 +242,8 @@ package body Vhdl.Sem_Specs is Attr_Decl : Iir; Attr_Chain_Parent : Iir; + + Is_Anon_Type : Boolean; begin -- LRM93 5.1 -- It is an error if the class of those names is not the same as that @@ -250,22 +252,31 @@ package body Vhdl.Sem_Specs is and then Get_Entity_Class_Kind (Decl) /= Attr_Class then if Check_Class then - Error_Msg_Sem - (+Attr, "%n is not of class %t", (+Decl, +Attr_Class)); - if Get_Kind (Decl) = Iir_Kind_Subtype_Declaration + -- If -frelaxed, specifying an attribute of class 'type' to + -- an anonynous type declaration is allowed. + Is_Anon_Type := Get_Kind (Decl) = Iir_Kind_Subtype_Declaration and then Get_Entity_Class (Attr) = Tok_Type and then Get_Type (Decl) /= Null_Iir and then Get_Base_Type (Get_Type (Decl)) /= Null_Iir - and then Get_Kind - (Get_Type_Declarator (Get_Base_Type (Get_Type (Decl)))) - = Iir_Kind_Anonymous_Type_Declaration - then + and then (Get_Kind (Get_Type_Declarator + (Get_Base_Type (Get_Type (Decl)))) + = Iir_Kind_Anonymous_Type_Declaration); + + if Is_Anon_Type then -- The type declaration declares an anonymous type -- and a named subtype. - Error_Msg_Sem - (+Decl, + Report_Start_Group; + Error_Msg_Sem_Relaxed + (Attr, Warnid_Specs, + "%n is not of class %t", (+Decl, +Attr_Class)); + Error_Msg_Sem_Relaxed + (Decl, Warnid_Specs, "%i declares both an anonymous type and a named subtype", - +Decl); + (1 => +Decl)); + Report_End_Group; + else + Error_Msg_Sem + (+Attr, "%n is not of class %t", (+Decl, +Attr_Class)); end if; end if; return; |