diff options
author | Thomas Quinot <quinot@adacore.com> | 2012-10-29 11:21:57 +0000 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2012-10-29 12:21:57 +0100 |
commit | 2d7b3fa49dd6dabc94eb6ad86ccdbefdb851cf78 (patch) | |
tree | 17a14bab582f62ecf5a790fbcbbc51ccd647d89e /gcc | |
parent | 465b65324931ff40fc4963ab1cff93b7af8de2b9 (diff) | |
download | gcc-2d7b3fa49dd6dabc94eb6ad86ccdbefdb851cf78.zip gcc-2d7b3fa49dd6dabc94eb6ad86ccdbefdb851cf78.tar.gz gcc-2d7b3fa49dd6dabc94eb6ad86ccdbefdb851cf78.tar.bz2 |
gnat_rm.texi, [...] (Sem_Prag.Analyze_Pragma): Handle new pragma Attribute_Definition.
2012-10-29 Thomas Quinot <quinot@adacore.com>
* gnat_rm.texi, sem_prag.adb, sem_util.adb, sem_util.ads,
par-prag.adb, par-util.adb, snames.ads-tmpl (Sem_Prag.Analyze_Pragma):
Handle new pragma Attribute_Definition.
(Sem_Util.Bad_Attribute): New routine, moved here
from par-util, so that it can be used by the above.
(Par_Util.Signal_Bad_Attribute): Processing moved to
Sem_Util.Bad_Attribute.
From-SVN: r192935
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ChangeLog | 10 | ||||
-rw-r--r-- | gcc/ada/gnat_rm.texi | 24 | ||||
-rw-r--r-- | gcc/ada/par-prag.adb | 1 | ||||
-rw-r--r-- | gcc/ada/par-util.adb | 15 | ||||
-rw-r--r-- | gcc/ada/sem_prag.adb | 42 | ||||
-rw-r--r-- | gcc/ada/sem_util.adb | 28 | ||||
-rw-r--r-- | gcc/ada/sem_util.ads | 8 | ||||
-rw-r--r-- | gcc/ada/snames.ads-tmpl | 2 |
8 files changed, 116 insertions, 14 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8546a34..ff6e85c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2012-10-29 Thomas Quinot <quinot@adacore.com> + + * gnat_rm.texi, sem_prag.adb, sem_util.adb, sem_util.ads, + par-prag.adb, par-util.adb, snames.ads-tmpl (Sem_Prag.Analyze_Pragma): + Handle new pragma Attribute_Definition. + (Sem_Util.Bad_Attribute): New routine, moved here + from par-util, so that it can be used by the above. + (Par_Util.Signal_Bad_Attribute): Processing moved to + Sem_Util.Bad_Attribute. + 2012-10-29 Robert Dewar <dewar@adacore.com> * s-tpoben.ads, s-taskin.ads, exp_ch3.adb: Minor reformatting. diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index c084b1c..098978c 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -107,6 +107,7 @@ Implementation Defined Pragmas * Pragma Assert:: * Pragma Assertion_Policy:: * Pragma Assume_No_Invalid_Values:: +* Pragma Attribute_Definition:: * Pragma Ast_Entry:: * Pragma C_Pass_By_Copy:: * Pragma Check:: @@ -845,6 +846,7 @@ consideration, the use of these pragmas should be minimized. * Pragma Assert:: * Pragma Assertion_Policy:: * Pragma Assume_No_Invalid_Values:: +* Pragma Attribute_Definition:: * Pragma Ast_Entry:: * Pragma C_Pass_By_Copy:: * Pragma Check:: @@ -1308,6 +1310,28 @@ resulting from an OpenVMS system service call. The pragma does not affect normal use of the entry. For further details on this pragma, see the DEC Ada Language Reference Manual, section 9.12a. +@node Pragma Attribute_Definition +@unnumberedsec Pragma Attribute_Definition +@findex Attribute_Definition +@noindent +Syntax: +@smallexample @c ada +pragma Attribute_Definition + ([Attribute =>] ATTRIBUTE_DESIGNATOR, + [Entity =>] LOCAL_NAME, + [Expression =>] EXPRESSION | NAME); +@end smallexample + +@noindent +If Attribute is a known attribute name, this pragma is equivalent to +the attribute definition clause: +@smallexample @c ada + for Entity'Attribute use Expression; +@end smallexample +else the pragma is ignored, and a warning is emitted. This allows source +code to be written that takes advantage of some new attribute, while remaining +compilable with earlier compilers. + @node Pragma C_Pass_By_Copy @unnumberedsec Pragma C_Pass_By_Copy @cindex Passing by copy diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index 5bbf914..7dcf940 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -1103,6 +1103,7 @@ begin Pragma_Atomic | Pragma_Atomic_Components | Pragma_Attach_Handler | + Pragma_Attribute_Definition | Pragma_Check | Pragma_Check_Name | Pragma_Check_Policy | diff --git a/gcc/ada/par-util.adb b/gcc/ada/par-util.adb index 0c23f93..3baf9f5 100644 --- a/gcc/ada/par-util.adb +++ b/gcc/ada/par-util.adb @@ -716,20 +716,7 @@ package body Util is procedure Signal_Bad_Attribute is begin - Error_Msg_N ("unrecognized attribute&", Token_Node); - - -- Check for possible misspelling - - Error_Msg_Name_1 := First_Attribute_Name; - while Error_Msg_Name_1 <= Last_Attribute_Name loop - if Is_Bad_Spelling_Of (Token_Name, Error_Msg_Name_1) then - Error_Msg_N -- CODEFIX - ("\possible misspelling of %", Token_Node); - exit; - end if; - - Error_Msg_Name_1 := Error_Msg_Name_1 + 1; - end loop; + Bad_Attribute (Token_Node, Token_Name, Warn => False); end Signal_Bad_Attribute; ----------------------------- diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index aee77f9..2957c85 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -6919,6 +6919,47 @@ package body Sem_Prag is Assume_No_Invalid_Values := False; end if; + -------------------------- + -- Attribute_Definition -- + -------------------------- + + -- pragma Attribute_Definition + -- ([Attribute =>] ATTRIBUTE_DESIGNATOR, + -- [Entity =>] LOCAL_NAME, + -- [Expression =>] EXPRESSION | NAME); + + when Pragma_Attribute_Definition => Attribute_Definition : declare + Attribute_Designator : constant Node_Id := Get_Pragma_Arg (Arg1); + Aname : Name_Id; + + begin + GNAT_Pragma; + Check_Arg_Count (3); + Check_Optional_Identifier (Arg1, "attribute"); + Check_Optional_Identifier (Arg2, "entity"); + Check_Optional_Identifier (Arg3, "expression"); + + if Nkind (Attribute_Designator) /= N_Identifier then + Error_Msg_N ("attribute name expected", Attribute_Designator); + return; + end if; + + Check_Arg_Is_Local_Name (Arg2); + + Aname := Chars (Attribute_Designator); + if not Is_Attribute_Name (Aname) then + Bad_Attribute (Attribute_Designator, Aname, Warn => True); + return; + end if; + + Rewrite (N, + Make_Attribute_Definition_Clause (Loc, + Name => Get_Pragma_Arg (Arg2), + Chars => Aname, + Expression => Get_Pragma_Arg (Arg3))); + Analyze (N); + end Attribute_Definition; + --------------- -- AST_Entry -- --------------- @@ -15289,6 +15330,7 @@ package body Sem_Prag is Pragma_Assert_And_Cut => -1, Pragma_Assertion_Policy => 0, Pragma_Assume_No_Invalid_Values => 0, + Pragma_Attribute_Definition => +3, Pragma_Asynchronous => -1, Pragma_Atomic => 0, Pragma_Atomic_Components => 0, diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 1c9eb64..690e30f 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -36,6 +36,7 @@ with Fname; use Fname; with Freeze; use Freeze; with Lib; use Lib; with Lib.Xref; use Lib.Xref; +with Namet.Sp; use Namet.Sp; with Nlists; use Nlists; with Nmake; use Nmake; with Output; use Output; @@ -404,6 +405,33 @@ package body Sem_Util is and then Scope_Depth (ST) >= Scope_Depth (SCT); end Available_Full_View_Of_Component; + ------------------- + -- Bad_Attribute -- + ------------------- + + procedure Bad_Attribute + (N : Node_Id; + Nam : Name_Id; + Warn : Boolean := False) + is + begin + Error_Msg_Warn := Warn; + Error_Msg_N ("unrecognized attribute&<", N); + + -- Check for possible misspelling + + Error_Msg_Name_1 := First_Attribute_Name; + while Error_Msg_Name_1 <= Last_Attribute_Name loop + if Is_Bad_Spelling_Of (Nam, Error_Msg_Name_1) then + Error_Msg_N -- CODEFIX + ("\possible misspelling of %<", N); + exit; + end if; + + Error_Msg_Name_1 := Error_Msg_Name_1 + 1; + end loop; + end Bad_Attribute; + -------------------------------- -- Bad_Predicated_Subtype_Use -- -------------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 1b089b8..bf6486d 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -108,6 +108,14 @@ package Sem_Util is -- are open, and the scope of the array is not outside the scope of the -- component. + procedure Bad_Attribute + (N : Node_Id; + Nam : Name_Id; + Warn : Boolean := False); + -- Called when node N is expected to contain a valid attribute name, and + -- Nam is found instead. If Warn is set True this is a warning, else this + -- is an error. + procedure Bad_Predicated_Subtype_Use (Msg : String; N : Node_Id; diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 7987c8a..0fd39c3 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -363,6 +363,7 @@ package Snames is Name_Annotate : constant Name_Id := N + $; -- GNAT Name_Assertion_Policy : constant Name_Id := N + $; -- Ada 05 Name_Assume_No_Invalid_Values : constant Name_Id := N + $; -- GNAT + Name_Attribute_Definition : constant Name_Id := N + $; -- GNAT Name_C_Pass_By_Copy : constant Name_Id := N + $; -- GNAT Name_Check_Name : constant Name_Id := N + $; -- GNAT Name_Check_Policy : constant Name_Id := N + $; -- GNAT @@ -1646,6 +1647,7 @@ package Snames is Pragma_Annotate, Pragma_Assertion_Policy, Pragma_Assume_No_Invalid_Values, + Pragma_Attribute_Definition, Pragma_C_Pass_By_Copy, Pragma_Check_Name, Pragma_Check_Policy, |