[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:
parent
3699edc41f
commit
cdcf1c7ae2
|
@ -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
|
||||
|
|
|
@ -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 --
|
||||
-----------------
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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})
|
||||
|
|
|
@ -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))) =
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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.
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
|
Loading…
Reference in New Issue