diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2013-09-10 15:05:40 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2013-09-10 15:05:40 +0000 |
commit | f55ce1694e4f99105ae340c55ce4b591e2a9b59c (patch) | |
tree | 054f0d78e3bf4bb0e53238efe06d4c199c493e06 /gcc | |
parent | a5109493ef83c6795389171db07e07cf5da11f85 (diff) | |
download | gcc-f55ce1694e4f99105ae340c55ce4b591e2a9b59c.tar.gz |
2013-09-10 Hristian Kirtchev <kirtchev@adacore.com>
* aspects.adb: Add entries in the Has_Aspect_Specifications_Flag
table for package body and body stubs.
(Move_Or_Merge_Aspects): New routine.
(Remove_Aspects): New routine.
* aspects.ads (Move_Aspects): Update comment on usage.
(Move_Or_Merge_Aspects): New routine.
(Remove_Aspects): New routine.
* par-ch3.adb: Update the grammar of private_type_declaration,
private_extension_declaration, object_renaming_declaration,
and exception_renaming_declaration.
(P_Subprogram): Parse the
aspect specifications that apply to a body stub.
* par-ch6.adb: Update the grammar of subprogram_body_stub and
generic_instantiation.
* par-ch7.adb: Update the grammar of package_declaration,
package_specification, package_body, package_renaming_declaration,
package_body_stub.
(P_Package): Parse the aspect specifications
that apply to a body, a body stub and package renaming.
* par-ch9.adb: Update the grammar of entry_declaration,
protected_body, protected_body_stub, task_body,
and task_body_stub.
(P_Protected): Add local variable
Aspect_Sloc. Add local constant Dummy_Node. Parse the aspect
specifications that apply to a protected body and a protected
body stub.
(P_Task): Add local variable Aspect_Sloc. Add local
constant Dummy_Node. Parse the aspect specifications that apply
to a task body and a task body stub.
* par-ch12.adb: Update the grammar of
generic_renaming_declaration.
(P_Generic): Parse the aspect
specifications that apply to a generic renaming.
* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Do not emit
an error when analyzing aspects that apply to a body stub. Such
aspects are relocated to the proper body.
* sem_ch7.adb (Analyze_Package_Body_Helper): Analyze the aspect
specifications that apply to a body.
* sem_ch9.adb (Analyze_Protected_Body): Warn about user-defined
aspects not being supported on protected bodies. Remove the
aspect specifications. (Analyze_Single_Protected_Declaration):
Analyze the aspects that apply to a single protected declaration.
(Analyze_Task_Body): Warn about user-defined aspects not being
supported on task bodies. Remove the aspect specifications.
* sem_ch10.adb: Add with and use clause for Aspects.
(Analyze_Package_Body_Stub): Propagate the aspect specifications
from the stub to the proper body.
* sem_ch13.adb (Analyze_Aspect_Specifications): Insert the
corresponding pragma of an aspect that applies to a body in the
declarations of the body.
* sinfo.ads: Update the gramma of expression_function,
private_type_declaration, private_extension_declaration,
object_renaming_declaration, exception_renaming_declaration,
package_renaming_declaration, subprogram_renaming_declaration,
generic_renaming_declaration, entry_declaration,
subprogram_body_stub, package_body_stub, task_body_stub,
generic_subprogram_declaration.
2013-09-10 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Analyze_Pragma): Add processing
for aspect/pragma SPARK_Mode when it applies to a [library-level]
subprogram or package [body].
2013-09-10 Robert Dewar <dewar@adacore.com>
* gnat_ugn.texi: Document that -gnatc and -gnatR cannot be
given together.
* switch-c.adb (Scan_Front_End_Switches): Give error if both
-gnatR and -gnatc given.
2013-09-10 Robert Dewar <dewar@adacore.com>
* g-table.ads, g-table.adb (For_Each): New generic procedure
(Sort_Table): New generic procedure.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@202460 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ChangeLog | 78 | ||||
-rw-r--r-- | gcc/ada/aspects.adb | 41 | ||||
-rw-r--r-- | gcc/ada/aspects.ads | 16 | ||||
-rw-r--r-- | gcc/ada/g-table.adb | 107 | ||||
-rw-r--r-- | gcc/ada/g-table.ads | 23 | ||||
-rw-r--r-- | gcc/ada/gnat_ugn.texi | 10 | ||||
-rw-r--r-- | gcc/ada/par-ch12.adb | 6 | ||||
-rw-r--r-- | gcc/ada/par-ch3.adb | 30 | ||||
-rw-r--r-- | gcc/ada/par-ch6.adb | 27 | ||||
-rw-r--r-- | gcc/ada/par-ch7.adb | 42 | ||||
-rw-r--r-- | gcc/ada/par-ch9.adb | 72 | ||||
-rw-r--r-- | gcc/ada/sem_ch10.adb | 13 | ||||
-rw-r--r-- | gcc/ada/sem_ch13.adb | 13 | ||||
-rw-r--r-- | gcc/ada/sem_ch6.adb | 9 | ||||
-rw-r--r-- | gcc/ada/sem_ch7.adb | 8 | ||||
-rw-r--r-- | gcc/ada/sem_ch9.adb | 36 | ||||
-rw-r--r-- | gcc/ada/sem_prag.adb | 59 | ||||
-rw-r--r-- | gcc/ada/sinfo.ads | 44 | ||||
-rw-r--r-- | gcc/ada/switch-c.adb | 15 |
19 files changed, 556 insertions, 93 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index cbf00794828..159bdd19e02 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,81 @@ +2013-09-10 Hristian Kirtchev <kirtchev@adacore.com> + + * aspects.adb: Add entries in the Has_Aspect_Specifications_Flag + table for package body and body stubs. + (Move_Or_Merge_Aspects): New routine. + (Remove_Aspects): New routine. + * aspects.ads (Move_Aspects): Update comment on usage. + (Move_Or_Merge_Aspects): New routine. + (Remove_Aspects): New routine. + * par-ch3.adb: Update the grammar of private_type_declaration, + private_extension_declaration, object_renaming_declaration, + and exception_renaming_declaration. + (P_Subprogram): Parse the + aspect specifications that apply to a body stub. + * par-ch6.adb: Update the grammar of subprogram_body_stub and + generic_instantiation. + * par-ch7.adb: Update the grammar of package_declaration, + package_specification, package_body, package_renaming_declaration, + package_body_stub. + (P_Package): Parse the aspect specifications + that apply to a body, a body stub and package renaming. + * par-ch9.adb: Update the grammar of entry_declaration, + protected_body, protected_body_stub, task_body, + and task_body_stub. + (P_Protected): Add local variable + Aspect_Sloc. Add local constant Dummy_Node. Parse the aspect + specifications that apply to a protected body and a protected + body stub. + (P_Task): Add local variable Aspect_Sloc. Add local + constant Dummy_Node. Parse the aspect specifications that apply + to a task body and a task body stub. + * par-ch12.adb: Update the grammar of + generic_renaming_declaration. + (P_Generic): Parse the aspect + specifications that apply to a generic renaming. + * sem_ch6.adb (Analyze_Subprogram_Body_Helper): Do not emit + an error when analyzing aspects that apply to a body stub. Such + aspects are relocated to the proper body. + * sem_ch7.adb (Analyze_Package_Body_Helper): Analyze the aspect + specifications that apply to a body. + * sem_ch9.adb (Analyze_Protected_Body): Warn about user-defined + aspects not being supported on protected bodies. Remove the + aspect specifications. (Analyze_Single_Protected_Declaration): + Analyze the aspects that apply to a single protected declaration. + (Analyze_Task_Body): Warn about user-defined aspects not being + supported on task bodies. Remove the aspect specifications. + * sem_ch10.adb: Add with and use clause for Aspects. + (Analyze_Package_Body_Stub): Propagate the aspect specifications + from the stub to the proper body. + * sem_ch13.adb (Analyze_Aspect_Specifications): Insert the + corresponding pragma of an aspect that applies to a body in the + declarations of the body. + * sinfo.ads: Update the gramma of expression_function, + private_type_declaration, private_extension_declaration, + object_renaming_declaration, exception_renaming_declaration, + package_renaming_declaration, subprogram_renaming_declaration, + generic_renaming_declaration, entry_declaration, + subprogram_body_stub, package_body_stub, task_body_stub, + generic_subprogram_declaration. + +2013-09-10 Hristian Kirtchev <kirtchev@adacore.com> + + * sem_prag.adb (Analyze_Pragma): Add processing + for aspect/pragma SPARK_Mode when it applies to a [library-level] + subprogram or package [body]. + +2013-09-10 Robert Dewar <dewar@adacore.com> + + * gnat_ugn.texi: Document that -gnatc and -gnatR cannot be + given together. + * switch-c.adb (Scan_Front_End_Switches): Give error if both + -gnatR and -gnatc given. + +2013-09-10 Robert Dewar <dewar@adacore.com> + + * g-table.ads, g-table.adb (For_Each): New generic procedure + (Sort_Table): New generic procedure. + 2013-09-10 Thomas Quinot <quinot@adacore.com> * adaint.c (__gnat_is_executable_file_attr): Should be true diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index d02edb25702..111b407867b 100644 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -271,6 +271,31 @@ package body Aspects is end if; end Move_Aspects; + --------------------------- + -- Move_Or_Merge_Aspects -- + --------------------------- + + procedure Move_Or_Merge_Aspects (From : Node_Id; To : Node_Id) is + begin + if Has_Aspects (From) then + + -- Merge the aspects of From into To. Make sure that From has no + -- aspects after the merge takes place. + + if Has_Aspects (To) then + Append_List + (List => Aspect_Specifications (From), + To => Aspect_Specifications (To)); + Remove_Aspects (From); + + -- Otherwise simply move the aspects + + else + Move_Aspects (From => From, To => To); + end if; + end if; + end Move_Or_Merge_Aspects; + ----------------------------------- -- Permits_Aspect_Specifications -- ----------------------------------- @@ -294,6 +319,8 @@ package body Aspects is N_Generic_Subprogram_Declaration => True, N_Object_Declaration => True, N_Object_Renaming_Declaration => True, + N_Package_Body => True, + N_Package_Body_Stub => True, N_Package_Declaration => True, N_Package_Instantiation => True, N_Package_Specification => True, @@ -302,6 +329,7 @@ package body Aspects is N_Private_Type_Declaration => True, N_Procedure_Instantiation => True, N_Protected_Body => True, + N_Protected_Body_Stub => True, N_Protected_Type_Declaration => True, N_Single_Protected_Declaration => True, N_Single_Task_Declaration => True, @@ -311,6 +339,7 @@ package body Aspects is N_Subprogram_Body_Stub => True, N_Subtype_Declaration => True, N_Task_Body => True, + N_Task_Body_Stub => True, N_Task_Type_Declaration => True, others => False); @@ -319,6 +348,18 @@ package body Aspects is return Has_Aspect_Specifications_Flag (Nkind (N)); end Permits_Aspect_Specifications; + -------------------- + -- Remove_Aspects -- + -------------------- + + procedure Remove_Aspects (N : Node_Id) is + begin + if Has_Aspects (N) then + Aspect_Specifications_Hash_Table.Remove (N); + Set_Has_Aspects (N, False); + end if; + end Remove_Aspects; + ----------------- -- Same_Aspect -- ----------------- diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index acaa4cc8cab..25c178f7772 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -698,16 +698,24 @@ package Aspects is -- Determine whether entity Id has aspect A procedure Move_Aspects (From : Node_Id; To : Node_Id); - -- Moves aspects from 'From' node to 'To' node. Has_Aspects (To) must be - -- False on entry. If Has_Aspects (From) is False, the call has no effect. - -- Otherwise the aspects are moved and on return Has_Aspects (To) is True, - -- and Has_Aspects (From) is False. + -- Relocate the aspect specifications of node From to node To. On entry it + -- is assumed that To does not have aspect specifications. If From has no + -- aspects, the routine has no effect. + + procedure Move_Or_Merge_Aspects (From : Node_Id; To : Node_Id); + -- Relocate the aspect specifications of node From to node To. If To has + -- aspects, the aspects of From are added to the aspects of To. If From has + -- no aspects, the routine has no effect. function Permits_Aspect_Specifications (N : Node_Id) return Boolean; -- Returns True if the node N is a declaration node that permits aspect -- specifications in the grammar. It is possible for other nodes to have -- aspect specifications as a result of Rewrite or Replace calls. + procedure Remove_Aspects (N : Node_Id); + -- Delete the aspect specifications associated with node N. If the node has + -- no aspects, the routine has no effect. + function Same_Aspect (A1 : Aspect_Id; A2 : Aspect_Id) return Boolean; -- Returns True if A1 and A2 are (essentially) the same aspect. This is not -- a simple equality test because e.g. Post and Postcondition are the same. diff --git a/gcc/ada/g-table.adb b/gcc/ada/g-table.adb index eeaa59bb6f7..9b3692bbe06 100644 --- a/gcc/ada/g-table.adb +++ b/gcc/ada/g-table.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2010, AdaCore -- +-- Copyright (C) 1998-2013, AdaCore -- -- -- -- 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- -- @@ -29,6 +29,8 @@ -- -- ------------------------------------------------------------------------------ +with GNAT.Heap_Sort_G; + with System; use System; with System.Memory; use System.Memory; @@ -114,6 +116,19 @@ package body GNAT.Table is Last_Val := Last_Val - 1; end Decrement_Last; + -------------- + -- For_Each -- + -------------- + + procedure For_Each is + Quit : Boolean := False; + begin + for Index in Table_Low_Bound .. Table_Index_Type (Last_Val) loop + Action (Index, Table (Index), Quit); + exit when Quit; + end loop; + end For_Each; + ---------- -- Free -- ---------- @@ -259,17 +274,17 @@ package body GNAT.Table is pragma Import (Ada, Allocated_Table); pragma Suppress (Range_Check, On => Allocated_Table); for Allocated_Table'Address use Allocated_Table_Address; - -- Allocated_Table represents the currently allocated array, plus - -- one element (the supplementary element is used to have a - -- convenient way of computing the address just past the end of the - -- current allocation). Range checks are suppressed because this unit - -- uses direct calls to System.Memory for allocation, and this can - -- yield misaligned storage (and we cannot rely on the bootstrap - -- compiler supporting specifically disabling alignment checks, so we - -- need to suppress all range checks). It is safe to suppress this check - -- here because we know that a (possibly misaligned) object of that type - -- does actually exist at that address. - -- ??? We should really improve the allocation circuitry here to + -- Allocated_Table represents the currently allocated array, plus one + -- element (the supplementary element is used to have a convenient + -- way of computing the address just past the end of the current + -- allocation). Range checks are suppressed because this unit uses + -- direct calls to System.Memory for allocation, and this can yield + -- misaligned storage (and we cannot rely on the bootstrap compiler + -- supporting specifically disabling alignment checks, so we need to + -- suppress all range checks). It is safe to suppress this check here + -- because we know that a (possibly misaligned) object of that type + -- does actually exist at that address. ??? We should really improve + -- the allocation circuitry here to -- guarantee proper alignment. Need_Realloc : constant Boolean := Integer (Index) > Max; @@ -324,6 +339,74 @@ package body GNAT.Table is end if; end Set_Last; + ---------------- + -- Sort_Table -- + ---------------- + + procedure Sort_Table is + + Temp : Table_Component_Type; + -- A temporary position to simulate index 0 + + -- Local subprograms + + function Index_Of (Idx : Natural) return Table_Index_Type; + -- Return index of Idx'th element of table + + function Lower_Than (Op1, Op2 : Natural) return Boolean; + -- Compare two components + + procedure Move (From : Natural; To : Natural); + -- Move one component + + package Heap_Sort is new GNAT.Heap_Sort_G (Move, Lower_Than); + + -------------- + -- Index_Of -- + -------------- + + function Index_Of (Idx : Natural) return Table_Index_Type is + J : constant Integer'Base := Table_Index_Type'Pos (First) + Idx - 1; + begin + return Table_Index_Type'Val (J); + end Index_Of; + + ---------- + -- Move -- + ---------- + + procedure Move (From : Natural; To : Natural) is + begin + if From = 0 then + Table (Index_Of (To)) := Temp; + elsif To = 0 then + Temp := Table (Index_Of (From)); + else + Table (Index_Of (To)) := Table (Index_Of (From)); + end if; + end Move; + + ---------------- + -- Lower_Than -- + ---------------- + + function Lower_Than (Op1, Op2 : Natural) return Boolean is + begin + if Op1 = 0 then + return Lt (Temp, Table (Index_Of (Op2))); + elsif Op2 = 0 then + return Lt (Table (Index_Of (Op1)), Temp); + else + return Lt (Table (Index_Of (Op1)), Table (Index_Of (Op2))); + end if; + end Lower_Than; + + -- Start of processing for Sort_Table + + begin + Heap_Sort.Sort (Natural (Last - First) + 1); + end Sort_Table; + begin Init; end GNAT.Table; diff --git a/gcc/ada/g-table.ads b/gcc/ada/g-table.ads index 5a879752e45..c9b75f61648 100644 --- a/gcc/ada/g-table.ads +++ b/gcc/ada/g-table.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1998-2010, AdaCore -- +-- Copyright (C) 1998-2013, AdaCore -- -- -- -- 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- -- @@ -201,4 +201,25 @@ package GNAT.Table is -- This means that a reference X.Table (X.Allocate) is incorrect, since -- the call to X.Allocate may modify the results of calling X.Table. + generic + with procedure Action + (Index : Table_Index_Type; + Item : Table_Component_Type; + Quit : in out Boolean) is <>; + procedure For_Each; + -- Calls procedure Action for each component of the table, or until + -- one of these calls set Quit to True. + + generic + with function Lt (Comp1, Comp2 : Table_Component_Type) return Boolean; + procedure Sort_Table; + -- This procedure sorts the components of the table into ascending + -- order making calls to Lt to do required comparisons, and using + -- assignments to move components around. The Lt function returns True + -- if Comp1 is less than Comp2 (in the sense of the desired sort), and + -- False if Comp1 is greater than Comp2. For equal objects it does not + -- matter if True or False is returned (it is slightly more efficient + -- to return False). The sort is not stable (the order of equal items + -- in the table is not preserved). + end GNAT.Table; diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 0a5f07db04a..4bf45940ae4 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -3697,7 +3697,9 @@ object file after compilation. If @command{gnatmake} is called with @option{-gnatc} as a builder switch (before @option{-cargs} or in package Builder of the project file) then @command{gnatmake} will not fail because it will not look for the object files after compilation, and it will not try -to build and link. +to build and link. This switch may not be given if a previous @code{-gnatR} +switch has been given, since @code{-gnatR} requires that the code generator +be called to complete determination of representation information. @item -gnatC @cindex @option{-gnatC} (@command{gcc}) @@ -4006,8 +4008,10 @@ Treat pragma Restrictions as Restriction_Warnings. @item ^-gnatR@r{[}0@r{/}1@r{/}2@r{/}3@r{[}s@r{]]}^/REPRESENTATION_INFO^ @cindex @option{-gnatR} (@command{gcc}) Output representation information for declared types and objects. -Note that this switch is not allowed if a previous --gnatD switch has been given, since these two switches are not compatible. +Note that this switch is not allowed if a previous @code{-gnatD} switch has +been given, since these two switches are not compatible. It is also not allowed +if a previous @code{-gnatc} switch has been given, since we must be generating +code to be able to determine representation information. @item -gnats @cindex @option{-gnats} (@command{gcc}) diff --git a/gcc/ada/par-ch12.adb b/gcc/ada/par-ch12.adb index 3c192f2877b..ed6e314dca0 100644 --- a/gcc/ada/par-ch12.adb +++ b/gcc/ada/par-ch12.adb @@ -74,10 +74,13 @@ package body Ch12 is -- GENERIC_RENAMING_DECLARATION ::= -- generic package DEFINING_PROGRAM_UNIT_NAME -- renames generic_package_NAME + -- [ASPECT_SPECIFICATIONS]; -- | generic procedure DEFINING_PROGRAM_UNIT_NAME -- renames generic_procedure_NAME + -- [ASPECT_SPECIFICATIONS]; -- | generic function DEFINING_PROGRAM_UNIT_NAME -- renames generic_function_NAME + -- [ASPECT_SPECIFICATIONS]; -- GENERIC_FORMAL_PARAMETER_DECLARATION ::= -- FORMAL_OBJECT_DECLARATION @@ -140,6 +143,8 @@ package body Ch12 is Scan; -- past RENAMES Set_Defining_Unit_Name (Decl_Node, Def_Unit); Set_Name (Decl_Node, P_Name); + + P_Aspect_Specifications (Decl_Node, Semicolon => False); TF_Semicolon; return Decl_Node; end if; @@ -211,7 +216,6 @@ package body Ch12 is else Gen_Decl := New_Node (N_Generic_Subprogram_Declaration, Gen_Sloc); - Set_Specification (Gen_Decl, P_Subprogram_Specification); if Nkind (Defining_Unit_Name (Specification (Gen_Decl))) = diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index eae388ba7ae..29126152d43 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, 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- -- @@ -275,13 +275,14 @@ package body Ch3 is -- PRIVATE_TYPE_DECLARATION ::= -- type DEFINING_IDENTIFIER [DISCRIMINANT_PART] - -- is [abstract] [tagged] [limited] private; + -- is [abstract] [tagged] [limited] private + -- [ASPECT_SPECIFICATIONS]; -- PRIVATE_EXTENSION_DECLARATION ::= -- type DEFINING_IDENTIFIER [DISCRIMINANT_PART] is -- [abstract] [limited | synchronized] -- new ancestor_SUBTYPE_INDICATION [and INTERFACE_LIST] - -- with private; + -- with private [ASPECT_SPECIFICATIONS]; -- TYPE_DEFINITION ::= -- ENUMERATION_TYPE_DEFINITION | INTEGER_TYPE_DEFINITION @@ -1277,12 +1278,15 @@ package body Ch3 is -- OBJECT_RENAMING_DECLARATION ::= -- DEFINING_IDENTIFIER : - -- [NULL_EXCLUSION] SUBTYPE_MARK renames object_NAME; + -- [NULL_EXCLUSION] SUBTYPE_MARK renames object_NAME + -- [ASPECT_SPECIFICATIONS]; -- | DEFINING_IDENTIFIER : - -- ACCESS_DEFINITION renames object_NAME; + -- ACCESS_DEFINITION renames object_NAME + -- [ASPECT_SPECIFICATIONS]; -- EXCEPTION_RENAMING_DECLARATION ::= - -- DEFINING_IDENTIFIER : exception renames exception_NAME; + -- DEFINING_IDENTIFIER : exception renames exception_NAME + -- [ASPECT_SPECIFICATIONS]; -- EXCEPTION_DECLARATION ::= -- DEFINING_IDENTIFIER_LIST : exception @@ -1669,15 +1673,19 @@ package body Ch3 is -- OBJECT_DECLARATION ::= -- DEFINING_IDENTIFIER_LIST : [aliased] [constant] - -- [NULL_EXCLUSION] SUBTYPE_INDICATION [:= EXPRESSION]; + -- [NULL_EXCLUSION] SUBTYPE_INDICATION [:= EXPRESSION] + -- [ASPECT_SPECIFICATIONS]; -- | DEFINING_IDENTIFIER_LIST : [aliased] [constant] - -- ACCESS_DEFINITION [:= EXPRESSION]; + -- ACCESS_DEFINITION [:= EXPRESSION] + -- [ASPECT_SPECIFICATIONS]; -- OBJECT_RENAMING_DECLARATION ::= -- DEFINING_IDENTIFIER : - -- [NULL_EXCLUSION] SUBTYPE_MARK renames object_NAME; + -- [NULL_EXCLUSION] SUBTYPE_MARK renames object_NAME + -- [ASPECT_SPECIFICATIONS]; -- | DEFINING_IDENTIFIER : - -- ACCESS_DEFINITION renames object_NAME; + -- ACCESS_DEFINITION renames object_NAME + -- [ASPECT_SPECIFICATIONS]; Not_Null_Present := P_Null_Exclusion; -- Ada 2005 (AI-231/423) @@ -1893,7 +1901,7 @@ package body Ch3 is -- type DEFINING_IDENTIFIER [DISCRIMINANT_PART] is -- [abstract] [limited | synchronized] -- new ancestor_SUBTYPE_INDICATION [and INTERFACE_LIST] - -- with private; + -- with private [ASPECT_SPECIFICATIONS]; -- RECORD_EXTENSION_PART ::= with RECORD_DEFINITION diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb index 7531f405fe1..f6aacd14057 100644 --- a/gcc/ada/par-ch6.adb +++ b/gcc/ada/par-ch6.adb @@ -161,13 +161,16 @@ package body Ch6 is -- [ASPECT_SPECIFICATIONS]; -- SUBPROGRAM_BODY_STUB ::= - -- SUBPROGRAM_SPECIFICATION is separate; + -- SUBPROGRAM_SPECIFICATION is separate + -- [ASPECT_SPECIFICATIONS]; -- GENERIC_INSTANTIATION ::= -- procedure DEFINING_PROGRAM_UNIT_NAME is - -- new generic_procedure_NAME [GENERIC_ACTUAL_PART]; + -- new generic_procedure_NAME [GENERIC_ACTUAL_PART] + -- [ASPECT_SPECIFICATIONS]; -- | function DEFINING_DESIGNATOR is - -- new generic_function_NAME [GENERIC_ACTUAL_PART]; + -- new generic_function_NAME [GENERIC_ACTUAL_PART] + -- [ASPECT_SPECIFICATIONS]; -- NULL_PROCEDURE_DECLARATION ::= -- SUBPROGRAM_SPECIFICATION is null; @@ -394,8 +397,8 @@ package body Ch6 is if Token = Tok_Identifier and then not Token_Is_At_Start_Of_Line then - T_Left_Paren; -- to generate message - Fpart_List := P_Formal_Part; + T_Left_Paren; -- to generate message + Fpart_List := P_Formal_Part; -- Otherwise scan out an optional formal part in the usual manner @@ -681,21 +684,21 @@ package body Ch6 is Sloc (Name_Node)); end if; + Scan; -- past SEPARATE + Stub_Node := New_Node (N_Subprogram_Body_Stub, Sloc (Specification_Node)); Set_Specification (Stub_Node, Specification_Node); - -- The specification has been parsed as part of a subprogram - -- declaration, and aspects have already been collected. - if Is_Non_Empty_List (Aspects) then - Set_Parent (Aspects, Stub_Node); - Set_Aspect_Specifications (Stub_Node, Aspects); + Error_Msg + ("aspect specifications must come after SEPARATE", + Sloc (First (Aspects))); end if; - Scan; -- past SEPARATE - Pop_Scope_Stack; + P_Aspect_Specifications (Stub_Node, Semicolon => False); TF_Semicolon; + Pop_Scope_Stack; return Stub_Node; -- Subprogram body or expression function case diff --git a/gcc/ada/par-ch7.adb b/gcc/ada/par-ch7.adb index d52a13d6c5b..0a658c963e1 100644 --- a/gcc/ada/par-ch7.adb +++ b/gcc/ada/par-ch7.adb @@ -38,28 +38,33 @@ package body Ch7 is -- renaming declaration or generic instantiation starting with PACKAGE -- PACKAGE_DECLARATION ::= - -- PACKAGE_SPECIFICATION - -- [ASPECT_SPECIFICATIONS]; + -- PACKAGE_SPECIFICATION; -- PACKAGE_SPECIFICATION ::= - -- package DEFINING_PROGRAM_UNIT_NAME is + -- package DEFINING_PROGRAM_UNIT_NAME + -- [ASPECT_SPECIFICATIONS] + -- is -- {BASIC_DECLARATIVE_ITEM} -- [private -- {BASIC_DECLARATIVE_ITEM}] -- end [[PARENT_UNIT_NAME .] IDENTIFIER] -- PACKAGE_BODY ::= - -- package body DEFINING_PROGRAM_UNIT_NAME is + -- package body DEFINING_PROGRAM_UNIT_NAME + -- [ASPECT_SPECIFICATIONS] + -- is -- DECLARATIVE_PART -- [begin -- HANDLED_SEQUENCE_OF_STATEMENTS] -- end [[PARENT_UNIT_NAME .] IDENTIFIER] -- PACKAGE_RENAMING_DECLARATION ::= - -- package DEFINING_IDENTIFIER renames package_NAME; + -- package DEFINING_IDENTIFIER renames package_NAME + -- [ASPECT_SPECIFICATIONS]; -- PACKAGE_BODY_STUB ::= - -- package body DEFINING_IDENTIFIER is separate; + -- package body DEFINING_IDENTIFIER is separate + -- [ASPECT_SPECIFICATIONS]; -- PACKAGE_INSTANTIATION ::= -- package DEFINING_PROGRAM_UNIT_NAME is @@ -141,6 +146,12 @@ package body Ch7 is Scope.Table (Scope.Last).Sloc := Token_Ptr; Name_Node := P_Defining_Program_Unit_Name; Scope.Table (Scope.Last).Labl := Name_Node; + + if Aspect_Specifications_Present then + Aspect_Sloc := Token_Ptr; + P_Aspect_Specifications (Dummy_Node, Semicolon => False); + end if; + TF_Is; if Separate_Present then @@ -149,16 +160,30 @@ package body Ch7 is end if; Scan; -- past SEPARATE - TF_Semicolon; - Pop_Scope_Stack; Package_Node := New_Node (N_Package_Body_Stub, Package_Sloc); Set_Defining_Identifier (Package_Node, Name_Node); + if Has_Aspects (Dummy_Node) then + Error_Msg + ("aspect specifications must come after SEPARATE", + Aspect_Sloc); + end if; + + P_Aspect_Specifications (Package_Node, Semicolon => False); + TF_Semicolon; + Pop_Scope_Stack; + else Package_Node := New_Node (N_Package_Body, Package_Sloc); Set_Defining_Unit_Name (Package_Node, Name_Node); + -- Move the aspect specifications to the body node + + if Has_Aspects (Dummy_Node) then + Move_Aspects (From => Dummy_Node, To => Package_Node); + end if; + -- In SPARK, a HIDE directive can be placed at the beginning of a -- package implementation, thus hiding the package body from SPARK -- tool-set. No violation of the SPARK restriction should be @@ -204,6 +229,7 @@ package body Ch7 is Set_Name (Package_Node, P_Qualified_Simple_Name); No_Constraint; + P_Aspect_Specifications (Package_Node, Semicolon => False); TF_Semicolon; Pop_Scope_Stack; diff --git a/gcc/ada/par-ch9.adb b/gcc/ada/par-ch9.adb index 2de05880b59..e1692c4a11b 100644 --- a/gcc/ada/par-ch9.adb +++ b/gcc/ada/par-ch9.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, 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- -- @@ -61,14 +61,15 @@ package body Ch9 is -- [is [new INTERFACE_LIST with] TASK_DEFINITION]; -- TASK_BODY ::= - -- task body DEFINING_IDENTIFIER is + -- task body DEFINING_IDENTIFIER [ASPECT_SPECIFICATIONS] is -- DECLARATIVE_PART -- begin -- HANDLED_SEQUENCE_OF_STATEMENTS -- end [task_IDENTIFIER] -- TASK_BODY_STUB ::= - -- task body DEFINING_IDENTIFIER is separate; + -- task body DEFINING_IDENTIFIER is separate + -- [ASPECT_SPECIFICATIONS]; -- This routine scans out a task declaration, task body, or task stub @@ -78,9 +79,15 @@ package body Ch9 is -- Error recovery: cannot raise Error_Resync function P_Task return Node_Id is - Name_Node : Node_Id; - Task_Node : Node_Id; - Task_Sloc : Source_Ptr; + Aspect_Sloc : Source_Ptr; + Name_Node : Node_Id; + Task_Node : Node_Id; + Task_Sloc : Source_Ptr; + + Dummy_Node : constant Node_Id := New_Node (N_Task_Body, Token_Ptr); + -- Placeholder node used to hold legal or prematurely declared aspect + -- specifications. Depending on the context, the aspect specifications + -- may be moved to a new node. begin Push_Scope_Stack; @@ -100,6 +107,11 @@ package body Ch9 is Discard_Junk_List (P_Known_Discriminant_Part_Opt); end if; + if Aspect_Specifications_Present then + Aspect_Sloc := Token_Ptr; + P_Aspect_Specifications (Dummy_Node, Semicolon => False); + end if; + TF_Is; -- Task stub @@ -108,6 +120,14 @@ package body Ch9 is Scan; -- past SEPARATE Task_Node := New_Node (N_Task_Body_Stub, Task_Sloc); Set_Defining_Identifier (Task_Node, Name_Node); + + if Has_Aspects (Dummy_Node) then + Error_Msg + ("aspect specifications must come after SEPARATE", + Aspect_Sloc); + end if; + + P_Aspect_Specifications (Task_Node, Semicolon => False); TF_Semicolon; Pop_Scope_Stack; -- remove unused entry @@ -116,6 +136,13 @@ package body Ch9 is else Task_Node := New_Node (N_Task_Body, Task_Sloc); Set_Defining_Identifier (Task_Node, Name_Node); + + -- Move the aspect specifications to the body node + + if Has_Aspects (Dummy_Node) then + Move_Aspects (From => Dummy_Node, To => Task_Node); + end if; + Parse_Decls_Begin_End (Task_Node); end if; @@ -367,12 +394,15 @@ package body Ch9 is -- is [new INTERFACE_LIST with] PROTECTED_DEFINITION; -- PROTECTED_BODY ::= - -- protected body DEFINING_IDENTIFIER is + -- protected body DEFINING_IDENTIFIER + -- [ASPECT_SPECIFICATIONS] + -- is -- {PROTECTED_OPERATION_ITEM} -- end [protected_IDENTIFIER]; -- PROTECTED_BODY_STUB ::= - -- protected body DEFINING_IDENTIFIER is separate; + -- protected body DEFINING_IDENTIFIER is separate + -- [ASPECT_SPECIFICATIONS]; -- This routine scans out a protected declaration, protected body -- or a protected stub. @@ -383,11 +413,17 @@ package body Ch9 is -- Error recovery: cannot raise Error_Resync function P_Protected return Node_Id is + Aspect_Sloc : Source_Ptr; Name_Node : Node_Id; Protected_Node : Node_Id; Protected_Sloc : Source_Ptr; Scan_State : Saved_Scan_State; + Dummy_Node : constant Node_Id := New_Node (N_Protected_Body, Token_Ptr); + -- Placeholder node used to hold legal or prematurely declared aspect + -- specifications. Depending on the context, the aspect specifications + -- may be moved to a new node. + begin Push_Scope_Stack; Scope.Table (Scope.Last).Etyp := E_Name; @@ -405,14 +441,28 @@ package body Ch9 is Discard_Junk_List (P_Known_Discriminant_Part_Opt); end if; + if Aspect_Specifications_Present then + Aspect_Sloc := Token_Ptr; + P_Aspect_Specifications (Dummy_Node, Semicolon => False); + end if; + TF_Is; -- Protected stub if Token = Tok_Separate then Scan; -- past SEPARATE + Protected_Node := New_Node (N_Protected_Body_Stub, Protected_Sloc); Set_Defining_Identifier (Protected_Node, Name_Node); + + if Has_Aspects (Dummy_Node) then + Error_Msg + ("aspect specifications must come after SEPARATE", + Aspect_Sloc); + end if; + + P_Aspect_Specifications (Protected_Node, Semicolon => False); TF_Semicolon; Pop_Scope_Stack; -- remove unused entry @@ -421,6 +471,8 @@ package body Ch9 is else Protected_Node := New_Node (N_Protected_Body, Protected_Sloc); Set_Defining_Identifier (Protected_Node, Name_Node); + + Move_Aspects (From => Dummy_Node, To => Protected_Node); Set_Declarations (Protected_Node, P_Protected_Operation_Items); End_Statements (Protected_Node); end if; @@ -800,8 +852,8 @@ package body Ch9 is -- ENTRY_DECLARATION ::= -- [OVERRIDING_INDICATOR] - -- entry DEFINING_IDENTIFIER [(DISCRETE_SUBTYPE_DEFINITION)] - -- PARAMETER_PROFILE; + -- entry DEFINING_IDENTIFIER + -- [(DISCRETE_SUBTYPE_DEFINITION)] PARAMETER_PROFILE -- [ASPECT_SPECIFICATIONS]; -- The caller has checked that the initial token is ENTRY, NOT or diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 87d2ab3c259..6c36bf2cdb7 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -23,6 +23,7 @@ -- -- ------------------------------------------------------------------------------ +with Aspects; use Aspects; with Atree; use Atree; with Debug; use Debug; with Einfo; use Einfo; @@ -1555,8 +1556,8 @@ package body Sem_Ch10 is ------------------------------- procedure Analyze_Package_Body_Stub (N : Node_Id) is - Id : constant Entity_Id := Defining_Identifier (N); - Nam : Entity_Id; + Id : constant Entity_Id := Defining_Identifier (N); + Nam : Entity_Id; begin -- The package declaration must be in the current declarative part @@ -1844,6 +1845,12 @@ package body Sem_Ch10 is SCO_Record (Unum); end if; + -- Propagate any aspect specifications associated with + -- with the stub to the proper body. + + Move_Or_Merge_Aspects + (From => N, To => Proper_Body (Unit (Comp_Unit))); + -- Analyze the unit if semantics active if not Fatal_Error (Unum) or else Try_Semantics then @@ -2327,8 +2334,8 @@ package body Sem_Ch10 is ---------------------------- procedure Analyze_Task_Body_Stub (N : Node_Id) is - Nam : Entity_Id := Current_Entity_In_Scope (Defining_Identifier (N)); Loc : constant Source_Ptr := Sloc (N); + Nam : Entity_Id := Current_Entity_In_Scope (Defining_Identifier (N)); begin Check_Stub_Level (N); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 40cc72957d5..ac9e736a8c0 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1781,7 +1781,6 @@ package body Sem_Ch13 is -- Warnings when Aspect_Warnings => - Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Sloc (Expr), @@ -2434,6 +2433,18 @@ package body Sem_Ch13 is Set_Has_Delayed_Aspects (E); Record_Rep_Item (E, Aspect); + -- When delay is not required and the context is a package body, + -- insert the pragma in the declarations of the body. + + elsif Nkind (N) = N_Package_Body then + if No (Declarations (N)) then + Set_Declarations (N, New_List); + end if; + + -- The pragma is added before source declarations + + Prepend_To (Declarations (N), Aitem); + -- When delay is not required and the context is not a compilation -- unit, we simply insert the pragma/attribute definition clause -- in sequence. diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 57712d83d9c..44ce304363b 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -2680,7 +2680,14 @@ package body Sem_Ch6 is -- a corresponding spec, but for which there may also be a spec_id. if Has_Aspects (N) then - if Present (Spec_Id) then + + -- Aspects that apply to a body stub are relocated to the proper + -- body. Do not emit an error in this case. + + if Present (Spec_Id) + and then Nkind (N) not in N_Body_Stub + and then Nkind (Parent (N)) /= N_Subunit + then Error_Msg_N ("aspect specifications must appear in subprogram declaration", N); diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 505fe9d9916..e06b6b997cf 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -219,11 +219,15 @@ package body Sem_Ch7 is -- the later is never used for name resolution. In this fashion there -- is only one visible entity that denotes the package. - -- Set Body_Id. Note that this Will be reset to point to the generic + -- Set Body_Id. Note that this will be reset to point to the generic -- copy later on in the generic case. Body_Id := Defining_Entity (N); + if Has_Aspects (N) then + Analyze_Aspect_Specifications (N, Body_Id); + end if; + if Present (Corresponding_Spec (N)) then -- Body is body of package instantiation. Corresponding spec has @@ -766,7 +770,7 @@ package body Sem_Ch7 is -- True when this package declaration is not a nested declaration begin - -- Analye aspect specifications immediately, since we need to recognize + -- Analyze aspect specifications immediately, since we need to recognize -- things like Pure early enough to diagnose violations during analysis. if Has_Aspects (N) then diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index 41b4d9ccb2a..52dcb90d184 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -1734,6 +1734,22 @@ package body Sem_Ch9 is Set_Ekind (Body_Id, E_Protected_Body); Spec_Id := Find_Concurrent_Spec (Body_Id); + -- Protected bodies are currently removed by the expander. Since there + -- are no language-defined aspects that apply to a protected body, it is + -- not worth changing the whole expansion to accomodate user-defined + -- aspects. Plus we cannot possibly known the semantics of user-defined + -- aspects in order to plan ahead. + + if Has_Aspects (N) then + Error_Msg_N + ("?user-defined aspects on protected bodies are not supported", N); + + -- The aspects are removed for now to prevent cascading errors down + -- stream. + + Remove_Aspects (N); + end if; + if Present (Spec_Id) and then Ekind (Spec_Id) = E_Protected_Type then @@ -2606,6 +2622,10 @@ package body Sem_Ch9 is -- disastrous result. Analyze_Protected_Type_Declaration (N); + + if Has_Aspects (N) then + Analyze_Aspect_Specifications (N, Id); + end if; end Analyze_Single_Protected_Declaration; ------------------------------------- @@ -2703,6 +2723,22 @@ package body Sem_Ch9 is Set_Scope (Body_Id, Current_Scope); Spec_Id := Find_Concurrent_Spec (Body_Id); + -- Task bodies are transformed into a subprogram spec and body pair by + -- the expander. Since there are no language-defined aspects that apply + -- to a task body, it is not worth changing the whole expansion to + -- accomodate user-defined aspects. Plus we cannot possibly known the + -- semantics of user-defined aspects in order to plan ahead. + + if Has_Aspects (N) then + Error_Msg_N + ("?user-defined aspects on task bodies are not supported", N); + + -- The aspects are removed for now to prevent cascading errors down + -- stream. + + Remove_Aspects (N); + end if; + -- The spec is either a task type declaration, or a single task -- declaration for which we have created an anonymous type. diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index f9dfab7568b..901ce4f8292 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -16633,11 +16633,52 @@ package body Sem_Prag is Stmt := Prev (Stmt); end loop; - -- If we get here, then we ran out of preceding statements. The - -- pragma is immediately within a body. + -- Handle all cases where the pragma is actually an aspect and + -- applies to a library-level package spec, body or subprogram. - if Nkind_In (Context, N_Package_Body, - N_Subprogram_Body) + -- function F ... with SPARK_Mode => ...; + -- package P with SPARK_Mode => ...; + -- package body P with SPARK_Mode => ... is + + -- The following circuitry simply prepares the proper context + -- for the general pragma processing mechanism below. + + if Nkind (Context) = N_Compilation_Unit_Aux then + Context := Unit (Parent (Context)); + + if Nkind_In (Context, N_Package_Declaration, + N_Subprogram_Declaration) + then + Context := Specification (Context); + end if; + end if; + + -- The pragma is at the top level of a package spec or appears + -- as an aspect on a subprogram. + + -- function F ... with SPARK_Mode => ...; + + -- package P is + -- pragma SPARK_Mode; + + if Nkind_In (Context, N_Function_Specification, + N_Package_Specification, + N_Procedure_Specification) + then + Spec_Id := Defining_Unit_Name (Context); + Chain_Pragma (Spec_Id, N); + + -- The pragma is immediately within a package or subprogram + -- body. + + -- function F ... is + -- pragma SPARK_Mode; + + -- package body P is + -- pragma SPARK_Mode; + + elsif Nkind_In (Context, N_Package_Body, + N_Subprogram_Body) then Spec_Id := Corresponding_Spec (Context); @@ -16650,14 +16691,12 @@ package body Sem_Prag is Chain_Pragma (Body_Id, N); Check_Conformance (Spec_Id, Body_Id); - -- The pragma is at the top level of a package spec - - elsif Nkind (Context) = N_Package_Specification then - Spec_Id := Defining_Unit_Name (Context); - Chain_Pragma (Spec_Id, N); - -- The pragma applies to the statements of a package body + -- package body P is + -- begin + -- pragma SPARK_Mode; + elsif Nkind (Context) = N_Handled_Sequence_Of_Statements and then Nkind (Parent (Context)) = N_Package_Body then diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 78ab2c19434..5af10be736e 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -4775,7 +4775,8 @@ package Sinfo is -- and put in its proper section when we know exactly where that is! -- EXPRESSION_FUNCTION ::= - -- FUNCTION SPECIFICATION IS (EXPRESSION); + -- FUNCTION SPECIFICATION IS (EXPRESSION) + -- [ASPECT_SPECIFICATIONS]; -- N_Expression_Function -- Sloc points to FUNCTION @@ -5010,7 +5011,8 @@ package Sinfo is -- PRIVATE_TYPE_DECLARATION ::= -- type DEFINING_IDENTIFIER [DISCRIMINANT_PART] - -- is [[abstract] tagged] [limited] private; + -- is [[abstract] tagged] [limited] private + -- [ASPECT_SPECIFICATIONS]; -- Note: TAGGED is not permitted in Ada 83 mode @@ -5032,7 +5034,7 @@ package Sinfo is -- type DEFINING_IDENTIFIER [DISCRIMINANT_PART] is -- [abstract] [limited | synchronized] -- new ancestor_SUBTYPE_INDICATION [and INTERFACE_LIST] - -- with private; + -- with private [ASPECT_SPECIFICATIONS]; -- Note: LIMITED, and private extension declarations are not allowed -- in Ada 83 mode. @@ -5102,9 +5104,11 @@ package Sinfo is -- OBJECT_RENAMING_DECLARATION ::= -- DEFINING_IDENTIFIER : - -- [NULL_EXCLUSION] SUBTYPE_MARK renames object_NAME; + -- [NULL_EXCLUSION] SUBTYPE_MARK renames object_NAME + -- [ASPECT_SPECIFICATIONS]; -- | DEFINING_IDENTIFIER : - -- ACCESS_DEFINITION renames object_NAME; + -- ACCESS_DEFINITION renames object_NAME + -- [ASPECT_SPECIFICATIONS]; -- Note: Access_Definition is an optional field that gives support to -- Ada 2005 (AI-230). The parser generates nodes that have either the @@ -5124,7 +5128,8 @@ package Sinfo is ----------------------------------------- -- EXCEPTION_RENAMING_DECLARATION ::= - -- DEFINING_IDENTIFIER : exception renames exception_NAME; + -- DEFINING_IDENTIFIER : exception renames exception_NAME + -- [ASPECT_SPECIFICATIONS]; -- N_Exception_Renaming_Declaration -- Sloc points to first identifier @@ -5136,7 +5141,8 @@ package Sinfo is --------------------------------------- -- PACKAGE_RENAMING_DECLARATION ::= - -- package DEFINING_PROGRAM_UNIT_NAME renames package_NAME; + -- package DEFINING_PROGRAM_UNIT_NAME renames package_NAME + -- [ASPECT_SPECIFICATIONS]; -- N_Package_Renaming_Declaration -- Sloc points to PACKAGE @@ -5149,7 +5155,8 @@ package Sinfo is ------------------------------------------ -- SUBPROGRAM_RENAMING_DECLARATION ::= - -- SUBPROGRAM_SPECIFICATION renames callable_entity_NAME; + -- SUBPROGRAM_SPECIFICATION renames callable_entity_NAME + -- [ASPECT_SPECIFICATIONS]; -- N_Subprogram_Renaming_Declaration -- Sloc points to RENAMES @@ -5167,10 +5174,13 @@ package Sinfo is -- GENERIC_RENAMING_DECLARATION ::= -- generic package DEFINING_PROGRAM_UNIT_NAME -- renames generic_package_NAME + -- [ASPECT_SPECIFICATIONS]; -- | generic procedure DEFINING_PROGRAM_UNIT_NAME -- renames generic_procedure_NAME + -- [ASPECT_SPECIFICATIONS]; -- | generic function DEFINING_PROGRAM_UNIT_NAME -- renames generic_function_NAME + -- [ASPECT_SPECIFICATIONS]; -- N_Generic_Package_Renaming_Declaration -- Sloc points to GENERIC @@ -5384,7 +5394,8 @@ package Sinfo is -- ENTRY_DECLARATION ::= -- [[not] overriding] -- entry DEFINING_IDENTIFIER - -- [(DISCRETE_SUBTYPE_DEFINITION)] PARAMETER_PROFILE; + -- [(DISCRETE_SUBTYPE_DEFINITION)] PARAMETER_PROFILE + -- [ASPECT_SPECIFICATIONS]; -- N_Entry_Declaration -- Sloc points to ENTRY @@ -5985,7 +5996,8 @@ package Sinfo is ---------------------------------- -- SUBPROGRAM_BODY_STUB ::= - -- SUBPROGRAM_SPECIFICATION is separate; + -- SUBPROGRAM_SPECIFICATION is separate + -- [ASPECT_SPECIFICATION]; -- N_Subprogram_Body_Stub -- Sloc points to FUNCTION or PROCEDURE @@ -5998,7 +6010,8 @@ package Sinfo is ------------------------------- -- PACKAGE_BODY_STUB ::= - -- package body DEFINING_IDENTIFIER is separate; + -- package body DEFINING_IDENTIFIER is separate + -- [ASPECT_SPECIFICATION]; -- N_Package_Body_Stub -- Sloc points to PACKAGE @@ -6011,7 +6024,8 @@ package Sinfo is ---------------------------- -- TASK_BODY_STUB ::= - -- task body DEFINING_IDENTIFIER is separate; + -- task body DEFINING_IDENTIFIER is separate + -- [ASPECT_SPECIFICATION]; -- N_Task_Body_Stub -- Sloc points to TASK @@ -6024,7 +6038,8 @@ package Sinfo is --------------------------------- -- PROTECTED_BODY_STUB ::= - -- protected body DEFINING_IDENTIFIER is separate; + -- protected body DEFINING_IDENTIFIER is separate + -- [ASPECT_SPECIFICATION]; -- Note: protected body stubs are not allowed in Ada 83 mode @@ -6225,7 +6240,8 @@ package Sinfo is ------------------------------------------ -- GENERIC_SUBPROGRAM_DECLARATION ::= - -- GENERIC_FORMAL_PART SUBPROGRAM_SPECIFICATION; + -- GENERIC_FORMAL_PART SUBPROGRAM_SPECIFICATION + -- [ASPECT_SPECIFICATIONS]; -- Note: Generic_Formal_Declarations can include pragmas diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index 0fc6bdb2188..cd647da818c 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -310,6 +310,13 @@ package body Switch.C is ("-gnatc must be first if combined with other switches"); end if; + -- Not allowed if previous -gnatR given + + if List_Representation_Info /= 0 then + Osint.Fail + ("-gnatc not allowed since -gnatR given previously"); + end if; + Ptr := Ptr + 1; Operating_Mode := Check_Semantics; @@ -1013,6 +1020,14 @@ package body Switch.C is ("-gnatR not permitted since -gnatD given previously"); end if; + -- Not allowed if previous -gnatc was given, since we must + -- call the code generator to determine rep information. + + if Operating_Mode = Check_Semantics then + Osint.Fail + ("-gnatR not permitted since -gnatc given previously"); + end if; + -- Set to annotate rep info, and set default -gnatR mode Back_Annotate_Rep_Info := True; |