+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.
* Pragma Assert::
* Pragma Assertion_Policy::
* Pragma Assume_No_Invalid_Values::
+* Pragma Attribute_Definition::
* Pragma Ast_Entry::
* Pragma C_Pass_By_Copy::
* Pragma Check::
* Pragma Assert::
* Pragma Assertion_Policy::
* Pragma Assume_No_Invalid_Values::
+* Pragma Attribute_Definition::
* Pragma Ast_Entry::
* Pragma C_Pass_By_Copy::
* Pragma Check::
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
Pragma_Atomic |
Pragma_Atomic_Components |
Pragma_Attach_Handler |
+ Pragma_Attribute_Definition |
Pragma_Check |
Pragma_Check_Name |
Pragma_Check_Policy |
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;
-----------------------------
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 --
---------------
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,
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;
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 --
--------------------------------
-- 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;
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
Pragma_Annotate,
Pragma_Assertion_Policy,
Pragma_Assume_No_Invalid_Values,
+ Pragma_Attribute_Definition,
Pragma_C_Pass_By_Copy,
Pragma_Check_Name,
Pragma_Check_Policy,
projects / platform / upstream / gcc.git / commitdiff