mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-12 07:20:27 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
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
This commit is contained in:
Arnaud Charlet 2014-07-17 08:58:11 +02:00
parent b16ffa3332
commit 52d9ba4d30
9 changed files with 167 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
gcc/ada/ChangeLog
View File

@ -1,3 +1,22 @@
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

1
gcc/ada/aspects.adb
View File

@ -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,

8
gcc/ada/aspects.ads
View File

@ -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,

25
gcc/ada/gnat_rm.texi
View File

@ -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

4
gcc/ada/s-imguns.ads
View File

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

77
gcc/ada/sem_ch13.adb
View File

@ -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 |

29
gcc/ada/sem_prag.adb
View File

@ -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

16
gcc/ada/sinfo.ads
View File

@ -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.

4
gcc/ada/sprint.adb
View File

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