This change introduces a new implementation defined pragma
"Attribute_Definition", which allows an attribute definition clause to be
expressed in a backward-compatible manner: compilers not supporting the
pragma, or the specified attribute, will just ignore it.
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-10-29 Thomas Quinot <qui...@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.
Index: gnat_rm.texi
===================================================================
--- gnat_rm.texi (revision 192933)
+++ gnat_rm.texi (working copy)
@@ -107,6 +107,7 @@
* 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 @@
* 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 @@
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
Index: sem_prag.adb
===================================================================
--- sem_prag.adb (revision 192934)
+++ sem_prag.adb (working copy)
@@ -6919,6 +6919,47 @@
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 @@
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,
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 192918)
+++ sem_util.adb (working copy)
@@ -36,6 +36,7 @@
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 @@
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 --
--------------------------------
Index: sem_util.ads
===================================================================
--- sem_util.ads (revision 192918)
+++ sem_util.ads (working copy)
@@ -108,6 +108,14 @@
-- 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;
Index: par-prag.adb
===================================================================
--- par-prag.adb (revision 192928)
+++ par-prag.adb (working copy)
@@ -1103,6 +1103,7 @@
Pragma_Atomic |
Pragma_Atomic_Components |
Pragma_Attach_Handler |
+ Pragma_Attribute_Definition |
Pragma_Check |
Pragma_Check_Name |
Pragma_Check_Policy |
Index: par-util.adb
===================================================================
--- par-util.adb (revision 192927)
+++ par-util.adb (working copy)
@@ -716,20 +716,7 @@
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;
-----------------------------
Index: snames.ads-tmpl
===================================================================
--- snames.ads-tmpl (revision 192929)
+++ snames.ads-tmpl (working copy)
@@ -363,6 +363,7 @@
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 @@
Pragma_Annotate,
Pragma_Assertion_Policy,
Pragma_Assume_No_Invalid_Values,
+ Pragma_Attribute_Definition,
Pragma_C_Pass_By_Copy,
Pragma_Check_Name,
Pragma_Check_Policy,
