[multiple changes]

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.

From-SVN: r212732

9 files changed, 167 insertions, 16 deletions

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