+2014-07-17 Robert Dewar <dewar@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.
+
+2014-07-17 Tristan Gingold <gingold@adacore.com>
+
+ * s-imguns.ads: Fix minor typo.
+
+2014-07-17 Thomas Quinot <quinot@adacore.com>
+
+ * sprint.adb: Minor reformatting.
+
2014-07-17 Robert Dewar <dewar@adacore.com>
* sprint.adb (Write_Itype): Print proper header for string
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,
Aspect_Abstract_State, -- GNAT
Aspect_Address,
Aspect_Alignment,
+ Aspect_Annotate, -- GNAT
Aspect_Attach_Handler,
Aspect_Bit_Order,
Aspect_Component_Size,
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,
-- 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
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,
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,
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,
Implementation Defined Aspects
* Aspect Abstract_State::
+* Aspect Annotate::
* Aspect Async_Readers::
* Aspect Async_Writers::
* Aspect Contract_Cases::
@noindent
Syntax:
@smallexample @c ada
-pragma Annotate (IDENTIFIER [,IDENTIFIER @{, ARG@}]);
+pragma Annotate (IDENTIFIER [,IDENTIFIER @{, ARG@}] [entity => local_NAME]);
ARG ::= NAME | EXPRESSION
@end smallexample
@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
@menu
* Aspect Abstract_State::
+* Aspect Annotate::
* Aspect Async_Readers::
* Aspect Async_Writers::
* Aspect Contract_Cases::
@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
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
------------------------------------------------------------------------------
-- This package contains the routines for supporting the Image attribute for
--- modular integer types up to Size Modular'Size, and also for conversion
+-- modular integer types up to Size Unsigned'Size, and also for conversion
-- operations required in Text_IO.Modular_IO for such types.
with System.Unsigned_Types;
-- Corresponds to pragma Implemented, construct the pragma
when Aspect_Synchronization =>
-
Make_Aitem_Pragma
(Pragma_Argument_Associations => New_List (
Make_Pragma_Argument_Association (Loc,
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.
-- 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 |
-- 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
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);
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
-- 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
-- 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
-- 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.
Write_Str_With_Col_Check ("not null ");
end if;
- -- Print type, we used to print the Object_Definition from
+ -- Print type. We used to print the Object_Definition from
-- the node, but it is much more useful to print the Etype
-- of the defining identifier for the case where the nominal
-- type is an unconstrained array type. For example, this
then
Sprint_Node (Etype (Def_Id));
- -- In other cases, the nominal type is fine to print
+ -- In other cases, the nominal type is fine to print
else
Sprint_Node (Odef);
projects / thirdparty / gcc.git / commitdiff
