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 |