mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-02-25 09:35:26 +08:00
Code Issues Packages Projects Releases Wiki Activity

gnat_rm.texi, [...] (Sem_Prag.Analyze_Pragma): Handle new pragma Attribute_Definition.

Browse Source 
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
This commit is contained in:
Thomas Quinot 2012-10-29 11:21:57 +00:00 committed by Arnaud Charlet
parent 465b653249
commit 2d7b3fa49d
8 changed files with 116 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gcc/ada/ChangeLog
View File

@ -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.

24
gcc/ada/gnat_rm.texi
View File

@ -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

1
gcc/ada/par-prag.adb
View File

@ -1103,6 +1103,7 @@ begin
Pragma_Atomic |
Pragma_Atomic_Components |
Pragma_Attach_Handler |
Pragma_Attribute_Definition |
Pragma_Check |
Pragma_Check_Name |
Pragma_Check_Policy |

15
gcc/ada/par-util.adb
View File

@ -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;
-----------------------------

42
gcc/ada/sem_prag.adb
View File

@ -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,

28
gcc/ada/sem_util.adb
View File

@ -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 --
--------------------------------

8
gcc/ada/sem_util.ads
View File

@ -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;

2
gcc/ada/snames.ads-tmpl
View File

@ -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,