OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

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.

From-SVN: r202460
This commit is contained in:
Arnaud Charlet 2013-09-10 17:05:40 +02:00
parent 3699edc41f
commit cdcf1c7ae2
19 changed files with 556 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

78
gcc/ada/ChangeLog
View File

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

41
gcc/ada/aspects.adb
View File

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

16
gcc/ada/aspects.ads
View File

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

107
gcc/ada/g-table.adb
View File

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

23
gcc/ada/g-table.ads
View File

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

10
gcc/ada/gnat_ugn.texi
View File

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

6
gcc/ada/par-ch12.adb
View File

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

30
gcc/ada/par-ch3.adb
View File

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

27
gcc/ada/par-ch6.adb
View File

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

42
gcc/ada/par-ch7.adb
View File

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

72
gcc/ada/par-ch9.adb
View File

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

13
gcc/ada/sem_ch10.adb
View File

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

13
gcc/ada/sem_ch13.adb
View File

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

9
gcc/ada/sem_ch6.adb
View File

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

8
gcc/ada/sem_ch7.adb
View File

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

36
gcc/ada/sem_ch9.adb
View File

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

59
gcc/ada/sem_prag.adb
View File

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

44
gcc/ada/sinfo.ads
View File

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

15
gcc/ada/switch-c.adb
View File

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