An optional final named argument [Entity => local_NAME] is allowed
for pragma Annotate to indicate that the annotation is for a particular
entity, and a corresponding Annotate aspect is introduced.
Given the test program:
1. package AspectAnn is
2. Y : constant Integer := 43;
3. X : Integer;
4. pragma Annotate (Hello, Goodbye, Y, Entity => X);
5. Z : Integer with
6. Annotate => (Hello, Goodbye, Y),
7. Annotate => Hello,
8. Annotate => (Goodbye);
9. end;
Compiling with -gnatG gives:
aspectann_E : short_integer := 0;
package aspectann is
aspectann__y : constant integer := 43;
aspectann__x : integer;
pragma annotate (hello, goodbye, aspectann__y, entity =>
aspectann__x);
aspectann__z : integer
with annotate => (hello, goodbye, y),
annotate => hello,
annotate => goodbye;
pragma annotate (hello, goodbye, aspectann__y, entity =>
aspectann__z);
pragma annotate (hello, entity => aspectann__z);
pragma annotate (goodbye, entity => aspectann__z);
end aspectann;
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-07-17 Robert Dewar <de...@adacore.com>
* aspects.ads, aspects.adb: Add entries for aspect Annotate.
* gnat_rm.texi: Document Entity argument for pragma Annotate and
Annotate aspect.
* sem_ch13.adb (Analyze_Aspect_Specification): Add processing
for Annotate aspect.
* sem_prag.adb (Analyze_Pragma, case Annotate): Allow optional
Entity argument at end.
* sinfo.ads (N_Aspect_Specification): Add note on Annotate aspect.
Index: gnat_rm.texi
===================================================================
--- gnat_rm.texi (revision 212728)
+++ gnat_rm.texi (working copy)
@@ -287,6 +287,7 @@
Implementation Defined Aspects
* Aspect Abstract_State::
+* Aspect Annotate::
* Aspect Async_Readers::
* Aspect Async_Writers::
* Aspect Contract_Cases::
@@ -1343,7 +1344,7 @@
@noindent
Syntax:
@smallexample @c ada
-pragma Annotate (IDENTIFIER [,IDENTIFIER @{, ARG@}]);
+pragma Annotate (IDENTIFIER [,IDENTIFIER @{, ARG@}] [entity => local_NAME]);
ARG ::= NAME | EXPRESSION
@end smallexample
@@ -1359,7 +1360,8 @@
@code{Standard.String} or else @code{Wide_String} or @code{Wide_Wide_String}
depending on the character literals they contain.
All other kinds of arguments are analyzed as expressions, and must be
-unambiguous.
+unambiguous. The last argument if present must have the identifier
+@code{Entity} and GNAT verifies that a local name is given.
The analyzed pragma is retained in the tree, but not otherwise processed
by any part of the GNAT compiler, except to generate corresponding note
@@ -7932,6 +7934,7 @@
@menu
* Aspect Abstract_State::
+* Aspect Annotate::
* Aspect Async_Readers::
* Aspect Async_Writers::
* Aspect Contract_Cases::
@@ -7981,6 +7984,24 @@
@noindent
This aspect is equivalent to pragma @code{Abstract_State}.
+@node Aspect Annotate
+@unnumberedsec Annotate
+@findex Annotate
+@noindent
+There are three forms of this aspect (where ID is an identifier,
+and ARG is a general expression).
+
+@table @code
+@item Annotate => ID
+Equivalent to @code{pragma Annotate (ID, Entity => Name);}
+
+@item Annotate => (ID)
+Equivalent to @code{pragma Annotate (ID, Entity => Name);}
+
+@item Annotate => (ID ,ID @{, ARG@})
+Equivalent to @code{pragma Annotate (ID, ID @{, ARG@}, Entity => Name);}
+@end table
+
@node Aspect Async_Readers
@unnumberedsec Aspect Async_Readers
@findex Async_Readers
Index: sinfo.ads
===================================================================
--- sinfo.ads (revision 212731)
+++ sinfo.ads (working copy)
@@ -1966,12 +1966,12 @@
-- N_SCIL_Dispatch_Table_Tag_Init node, this is the type being declared).
-- SCIL_Controlling_Tag (Node5-Sem)
- -- Present in N_SCIL_Dispatching_Call nodes. References the
- -- controlling tag of a dispatching call. This is usually an
- -- N_Selected_Component node (for a _tag component), but may
- -- be an N_Object_Declaration or N_Parameter_Specification node
- -- in some cases (e.g., for a call to a classwide streaming operation
- -- or to an instance of Ada.Tags.Generic_Dispatching_Constructor).
+ -- Present in N_SCIL_Dispatching_Call nodes. References the controlling
+ -- tag of a dispatching call. This is usually an N_Selected_Component
+ -- node (for a _tag component), but may be an N_Object_Declaration or
+ -- N_Parameter_Specification node in some cases (e.g., for a call to
+ -- a classwide streaming operation or a call to an instance of
+ -- Ada.Tags.Generic_Dispatching_Constructor).
-- SCIL_Tag_Value (Node5-Sem)
-- Present in N_SCIL_Membership_Test nodes. Used to reference the tag
@@ -7069,6 +7069,10 @@
-- ASPECT_DEFINITION ::= NAME | EXPRESSION
+ -- Note that for Annotate, the ASPECT_DEFINITION is a pure positional
+ -- aggregate with the elements of the aggregate corresponding to the
+ -- successive arguments of the corresponding pragma.
+
-- See separate package Aspects for details on the incorporation of
-- these nodes into the tree, and how aspect specifications for a given
-- declaration node are associated with that node.
Index: sem_prag.adb
===================================================================
--- sem_prag.adb (revision 212656)
+++ sem_prag.adb (working copy)
@@ -11027,7 +11027,8 @@
-- Annotate --
--------------
- -- pragma Annotate (IDENTIFIER [, IDENTIFIER {, ARG}]);
+ -- pragma Annotate
+ -- (IDENTIFIER [, IDENTIFIER {, ARG}] [,Entity => local_NAME]);
-- ARG ::= NAME | EXPRESSION
-- The first two arguments are by convention intended to refer to an
@@ -11041,6 +11042,29 @@
begin
GNAT_Pragma;
Check_At_Least_N_Arguments (1);
+
+ -- See if last argument is Entity => local_Name, and if so process
+ -- and then remove it for remaining processing.
+
+ declare
+ Last_Arg : constant Node_Id :=
+ Last (Pragma_Argument_Associations (N));
+
+ begin
+ if Nkind (Last_Arg) = N_Pragma_Argument_Association
+ and then Chars (Last_Arg) = Name_Entity
+ then
+ Check_Arg_Is_Local_Name (Last_Arg);
+ Arg_Count := Arg_Count - 1;
+
+ -- Not allowed in compiler units (bootstrap issues)
+
+ Check_Compiler_Unit ("Entity for pragma Annotate", N);
+ end if;
+ end;
+
+ -- Continue processing with last argument removed for now
+
Check_Arg_Is_Identifier (Arg1);
Check_No_Identifiers;
Store_Note (N);
@@ -21276,6 +21300,7 @@
declare
Last_Arg : constant Node_Id :=
Last (Pragma_Argument_Associations (N));
+
begin
if Nkind (Last_Arg) = N_Pragma_Argument_Association
and then Chars (Last_Arg) = Name_Reason
@@ -21287,7 +21312,7 @@
-- Not allowed in compiler units (bootstrap issues)
- Check_Compiler_Unit ("Reason for pragma Warnings", N);
+ Check_Compiler_Unit ("Reason for pragma Warnings", N);
-- No REASON string, set null string as reason
Index: aspects.adb
===================================================================
--- aspects.adb (revision 212640)
+++ aspects.adb (working copy)
@@ -495,6 +495,7 @@
Aspect_Address => Aspect_Address,
Aspect_Alignment => Aspect_Alignment,
Aspect_All_Calls_Remote => Aspect_All_Calls_Remote,
+ Aspect_Annotate => Aspect_Annotate,
Aspect_Async_Readers => Aspect_Async_Readers,
Aspect_Async_Writers => Aspect_Async_Writers,
Aspect_Asynchronous => Aspect_Asynchronous,
Index: aspects.ads
===================================================================
--- aspects.ads (revision 212640)
+++ aspects.ads (working copy)
@@ -77,6 +77,7 @@
Aspect_Abstract_State, -- GNAT
Aspect_Address,
Aspect_Alignment,
+ Aspect_Annotate, -- GNAT
Aspect_Attach_Handler,
Aspect_Bit_Order,
Aspect_Component_Size,
@@ -215,6 +216,7 @@
Implementation_Defined_Aspect : constant array (Aspect_Id) of Boolean :=
(Aspect_Abstract_State => True,
+ Aspect_Annotate => True,
Aspect_Async_Readers => True,
Aspect_Async_Writers => True,
Aspect_Contract_Cases => True,
@@ -253,7 +255,8 @@
-- the same aspect attached to the same declaration are allowed.
No_Duplicates_Allowed : constant array (Aspect_Id) of Boolean :=
- (Aspect_Test_Case => False,
+ (Aspect_Annotate => False,
+ Aspect_Test_Case => False,
others => True);
-- The following subtype defines aspects corresponding to library unit
@@ -292,6 +295,7 @@
Aspect_Abstract_State => Expression,
Aspect_Address => Expression,
Aspect_Alignment => Expression,
+ Aspect_Annotate => Expression,
Aspect_Attach_Handler => Expression,
Aspect_Bit_Order => Expression,
Aspect_Component_Size => Expression,
@@ -370,6 +374,7 @@
Aspect_Address => Name_Address,
Aspect_Alignment => Name_Alignment,
Aspect_All_Calls_Remote => Name_All_Calls_Remote,
+ Aspect_Annotate => Name_Annotate,
Aspect_Async_Readers => Name_Async_Readers,
Aspect_Async_Writers => Name_Async_Writers,
Aspect_Asynchronous => Name_Asynchronous,
@@ -663,6 +668,7 @@
Aspect_Write => Always_Delay,
Aspect_Abstract_State => Never_Delay,
+ Aspect_Annotate => Never_Delay,
Aspect_Convention => Never_Delay,
Aspect_Dimension => Never_Delay,
Aspect_Dimension_System => Never_Delay,
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 212727)
+++ sem_ch13.adb (working copy)
@@ -1697,7 +1697,6 @@
-- Corresponds to pragma Implemented, construct the pragma
when Aspect_Synchronization =>
-
Make_Aitem_Pragma
(Pragma_Argument_Associations => New_List (
Make_Pragma_Argument_Association (Loc,
@@ -2480,6 +2479,81 @@
end;
end if;
+ -- Case 2e: Annotate aspect
+
+ when Aspect_Annotate =>
+ declare
+ Args : List_Id;
+ Pargs : List_Id;
+ Arg : Node_Id;
+
+ begin
+ -- The argument can be a single identifier
+
+ if Nkind (Expr) = N_Identifier then
+
+ -- One level of parens is allowed
+
+ if Paren_Count (Expr) > 1 then
+ Error_Msg_F ("extra parentheses ignored", Expr);
+ end if;
+
+ Set_Paren_Count (Expr, 0);
+
+ -- Add the single item to the list
+
+ Args := New_List (Expr);
+
+ -- Otherwise we must have an aggregate
+
+ elsif Nkind (Expr) = N_Aggregate then
+
+ -- Must be positional
+
+ if Present (Component_Associations (Expr)) then
+ Error_Msg_F
+ ("purely positional aggregate required", Expr);
+ goto Continue;
+ end if;
+
+ -- Must not be parenthesized
+
+ if Paren_Count (Expr) /= 0 then
+ Error_Msg_F ("extra parentheses ignored", Expr);
+ end if;
+
+ -- List of arguments is list of aggregate expressions
+
+ Args := Expressions (Expr);
+
+ -- Anything else is illegal
+
+ else
+ Error_Msg_F ("wrong form for Annotate aspect", Expr);
+ goto Continue;
+ end if;
+
+ -- Prepare pragma arguments
+
+ Pargs := New_List;
+ Arg := First (Args);
+ while Present (Arg) loop
+ Append_To (Pargs,
+ Make_Pragma_Argument_Association (Sloc (Arg),
+ Expression => Relocate_Node (Arg)));
+ Next (Arg);
+ end loop;
+
+ Append_To (Pargs,
+ Make_Pragma_Argument_Association (Sloc (Ent),
+ Chars => Name_Entity,
+ Expression => Ent));
+
+ Make_Aitem_Pragma
+ (Pragma_Argument_Associations => Pargs,
+ Pragma_Name => Name_Annotate);
+ end;
+
-- Case 3 : Aspects that don't correspond to pragma/attribute
-- definition clause.
@@ -8271,6 +8345,7 @@
-- Here is the list of aspects that don't require delay analysis
when Aspect_Abstract_State |
+ Aspect_Annotate |
Aspect_Contract_Cases |
Aspect_Dimension |
Aspect_Dimension_System |
