From 52d9ba4d30e98209b2d7f0a04fa2d59ce2e6b3af Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 17 Jul 2014 08:58:11 +0200 Subject: [multiple changes] 2014-07-17 Robert Dewar * 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 * s-imguns.ads: Fix minor typo. 2014-07-17 Thomas Quinot * sprint.adb: Minor reformatting. From-SVN: r212732 --- gcc/ada/ChangeLog | 19 +++++++++++++ gcc/ada/aspects.adb | 1 + gcc/ada/aspects.ads | 8 +++++- gcc/ada/gnat_rm.texi | 25 +++++++++++++++-- gcc/ada/s-imguns.ads | 4 +-- gcc/ada/sem_ch13.adb | 77 +++++++++++++++++++++++++++++++++++++++++++++++++++- gcc/ada/sem_prag.adb | 29 ++++++++++++++++++-- gcc/ada/sinfo.ads | 16 +++++++---- gcc/ada/sprint.adb | 4 +-- 9 files changed, 167 insertions(+), 16 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0dfddec..971d62c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,24 @@ 2014-07-17 Robert Dewar + * 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 + + * s-imguns.ads: Fix minor typo. + +2014-07-17 Thomas Quinot + + * sprint.adb: Minor reformatting. + +2014-07-17 Robert Dewar + * sprint.adb (Write_Itype): Print proper header for string literal subtype. diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index d79566d..88bd789 100644 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -495,6 +495,7 @@ package body Aspects is 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, diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index 8199df9..7756117 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -77,6 +77,7 @@ package Aspects is Aspect_Abstract_State, -- GNAT Aspect_Address, Aspect_Alignment, + Aspect_Annotate, -- GNAT Aspect_Attach_Handler, Aspect_Bit_Order, Aspect_Component_Size, @@ -215,6 +216,7 @@ package Aspects is 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 @@ package Aspects is -- 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 @@ package Aspects is 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 @@ package Aspects is 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 @@ package Aspects is 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, diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 48d7ea4..f7b7403 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -287,6 +287,7 @@ Implementation Defined Pragmas Implementation Defined Aspects * Aspect Abstract_State:: +* Aspect Annotate:: * Aspect Async_Readers:: * Aspect Async_Writers:: * Aspect Contract_Cases:: @@ -1343,7 +1344,7 @@ in the two situations. @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 @@ String literals are assumed to be either of type @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 @@ clause. @menu * Aspect Abstract_State:: +* Aspect Annotate:: * Aspect Async_Readers:: * Aspect Async_Writers:: * Aspect Contract_Cases:: @@ -7981,6 +7984,24 @@ clause. @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 diff --git a/gcc/ada/s-imguns.ads b/gcc/ada/s-imguns.ads index 2686a34..c6f733a 100644 --- a/gcc/ada/s-imguns.ads +++ b/gcc/ada/s-imguns.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -30,7 +30,7 @@ ------------------------------------------------------------------------------ -- 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; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index da4252d..2381f5c 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1697,7 +1697,6 @@ package body Sem_Ch13 is -- 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 @@ package body Sem_Ch13 is 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 @@ package body Sem_Ch13 is -- 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 | diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index d200f37..5e26672 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -11027,7 +11027,8 @@ package body Sem_Prag is -- 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 @@ package body Sem_Prag is 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 @@ package body Sem_Prag is 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 @@ package body Sem_Prag is -- 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 diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index d611648..31ebb59 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -1966,12 +1966,12 @@ package Sinfo is -- 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 @@ package Sinfo is -- 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. diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index f6980ab..2952617 100644 --- a/gcc/ada/sprint.adb +++ b/gcc/ada/sprint.adb @@ -2247,7 +2247,7 @@ package body Sprint is 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 @@ -2267,7 +2267,7 @@ package body Sprint is 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); -- cgit v1.1