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

s-rident.ads: Add various missing Ada 2012 restrictions... 

2013-04-12  Ed Schonberg  <schonberg@adacore.com>

	* s-rident.ads: Add various missing Ada 2012 restrictions:
	No_Access_Parameter_Allocators, No_Coextensions,
	No_Use_Of_Attribute, No_Use_Of_Pragma.
	* snames.ads-tmpl: Add corresponding names.
	* restrict.ads restrict.adb: Subprograms and data structures to
	handle aspects No_Use_Of_Attribute and No_Use_Of_Pragma.
	* sem_ch4.adb: Correct name of restrictions is
	No_Standard_Allocators_After_Elaboration.
	* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Check
	violation of restriction No_Use_Of_Attribute.
	* sem_prag.adb (Process_Restrictions_Or_Restriction_Warnings):
	Set restrictions No_Use_Of_Pragma and No_Use_Of_Attribute.
	(Analyze_Pragma): Check violation of restriction No_Use_Of_Pragma.
	* sem_res.adb: Check restrictions No_Access_Parameter_Allocators
	and No_Coextensions.
	* bcheck.adb: Correct name of restrictions is
	No_Standard_Allocators_After_Elaboration.
	* gnatbind.adb: Correct name of restrictions is
	No_Standard_Allocators_After_Elaboration.

From-SVN: r197907
This commit is contained in:
Ed Schonberg 2013-04-12 13:12:02 +00:00 committed by Arnaud Charlet
parent d9f8616ee4
commit 57f4c2887e
11 changed files with 300 additions and 89 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
gcc/ada/ChangeLog
View File

@ -1,3 +1,25 @@
2013-04-12 Ed Schonberg <schonberg@adacore.com>
* s-rident.ads: Add various missing Ada 2012 restrictions:
No_Access_Parameter_Allocators, No_Coextensions,
No_Use_Of_Attribute, No_Use_Of_Pragma.
* snames.ads-tmpl: Add corresponding names.
* restrict.ads restrict.adb: Subprograms and data structures to
handle aspects No_Use_Of_Attribute and No_Use_Of_Pragma.
* sem_ch4.adb: Correct name of restrictions is
No_Standard_Allocators_After_Elaboration.
* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Check
violation of restriction No_Use_Of_Attribute.
* sem_prag.adb (Process_Restrictions_Or_Restriction_Warnings):
Set restrictions No_Use_Of_Pragma and No_Use_Of_Attribute.
(Analyze_Pragma): Check violation of restriction No_Use_Of_Pragma.
* sem_res.adb: Check restrictions No_Access_Parameter_Allocators
and No_Coextensions.
* bcheck.adb: Correct name of restrictions is
No_Standard_Allocators_After_Elaboration.
* gnatbind.adb: Correct name of restrictions is
No_Standard_Allocators_After_Elaboration.
2013-04-12 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Analyze_Pragma, (Check_Mode_Restriction_In_Function):

6
gcc/ada/bcheck.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- --
@ -923,9 +923,9 @@ package body Bcheck is
and then ALIs.Table (ALIs.First).Allocator_In_Body
then
Cumulative_Restrictions.Violated
(No_Allocators_After_Elaboration) := True;
(No_Standard_Allocators_After_Elaboration) := True;
ALIs.Table (ALIs.First).Restrictions.Violated
(No_Allocators_After_Elaboration) := True;
(No_Standard_Allocators_After_Elaboration) := True;
end if;
-- Loop through all restriction violations

4
gcc/ada/gnatbind.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- --
@ -143,7 +143,7 @@ procedure Gnatbind is
-- should not be listed.
No_Restriction_List : constant array (All_Restrictions) of Boolean :=
(No_Allocators_After_Elaboration => True,
(No_Standard_Allocators_After_Elaboration => True,
-- This involves run-time conditions not checkable at compile time
No_Anonymous_Allocators => True,

126
gcc/ada/restrict.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- --
@ -68,6 +68,24 @@ package body Restrict is
-- Set True if any entry of No_Specifcation_Of_Aspects has been set True.
-- Once set True, this is never turned off again.
No_Use_Of_Attribute : array (Attribute_Id) of Source_Ptr :=
(others => No_Location);
No_Use_Of_Attribute_Warning : array (Attribute_Id) of Boolean :=
(others => False);
No_Use_Of_Attribute_Set : Boolean := False;
-- Indicates that No_Use_Of_Attribute was set at least once.
No_Use_Of_Pragma : array (Pragma_Id) of Source_Ptr :=
(others => No_Location);
No_Use_Of_Pragma_Warning : array (Pragma_Id) of Boolean :=
(others => False);
No_Use_Of_Pragma_Set : Boolean := False;
-- Indicates that No_Use_Of_Pragma was set at least once.
-----------------------
-- Local Subprograms --
-----------------------
@ -287,6 +305,74 @@ package body Restrict is
Check_Restriction (No_Implicit_Heap_Allocations, N);
end Check_No_Implicit_Heap_Alloc;
-------------------------------------------
-- Check_Restriction_No_Use_Of_Attribute --
--------------------------------------------
procedure Check_Restriction_No_Use_Of_Attribute (N : Node_Id) is
Id : constant Name_Id := Chars (N);
A_Id : constant Attribute_Id := Get_Attribute_Id (Id);
begin
-- Ignore call if node N is not in the main source unit, since we only
-- give messages for the main unit. This avoids giving messages for
-- aspects that are specified in withed units.
if not In_Extended_Main_Source_Unit (N) then
return;
end if;
-- If nothing set, nothing to check.
if not No_Use_Of_Attribute_Set then
return;
end if;
Error_Msg_Sloc := No_Use_Of_Attribute (A_Id);
if Error_Msg_Sloc /= No_Location then
Error_Msg_Node_1 := N;
Error_Msg_Warn := No_Use_Of_Attribute_Warning (A_Id);
Error_Msg_N
("<violation of restriction `No_Use_Of_Attribute '='> &`#",
N);
end if;
end Check_Restriction_No_Use_Of_Attribute;
----------------------------------------
-- Check_Restriction_No_Use_Of_Pragma --
----------------------------------------
procedure Check_Restriction_No_Use_Of_Pragma (N : Node_Id) is
Id : constant Node_Id := Pragma_Identifier (N);
P_Id : constant Pragma_Id := Get_Pragma_Id (Chars (Id));
begin
-- Ignore call if node N is not in the main source unit, since we only
-- give messages for the main unit. This avoids giving messages for
-- aspects that are specified in withed units.
if not In_Extended_Main_Source_Unit (N) then
return;
end if;
-- If nothing set, nothing to check.
if not No_Use_Of_Pragma_Set then
return;
end if;
Error_Msg_Sloc := No_Use_Of_Pragma (P_Id);
if Error_Msg_Sloc /= No_Location then
Error_Msg_Node_1 := Id;
Error_Msg_Warn := No_Use_Of_Pragma_Warning (P_Id);
Error_Msg_N
("<violation of restriction `No_Use_Of_Pragma '='> &`#",
Id);
end if;
end Check_Restriction_No_Use_Of_Pragma;
-----------------------------------
-- Check_Obsolescent_2005_Entity --
-----------------------------------
@ -1271,6 +1357,44 @@ package body Restrict is
No_Specification_Of_Aspect_Set := True;
end Set_Restriction_No_Specification_Of_Aspect;
-----------------------------------------
-- Set_Restriction_No_Use_Of_Attribute --
-----------------------------------------
procedure Set_Restriction_No_Use_Of_Attribute
(N : Node_Id;
Warning : Boolean)
is
A_Id : constant Attribute_Id := Get_Attribute_Id (Chars (N));
begin
No_Use_Of_Attribute_Set := True;
No_Use_Of_Attribute (A_Id) := Sloc (N);
if Warning = False then
No_Use_Of_Attribute_Warning (A_Id) := False;
end if;
end Set_Restriction_No_Use_Of_Attribute;
--------------------------------------
-- Set_Restriction_No_Use_Of_Pragma --
--------------------------------------
procedure Set_Restriction_No_Use_Of_Pragma
(N : Node_Id;
Warning : Boolean)
is
A_Id : constant Pragma_Id := Get_Pragma_Id (Chars (N));
begin
No_Use_Of_Pragma_Set := True;
No_Use_Of_Pragma (A_Id) := Sloc (N);
if Warning = False then
No_Use_Of_Pragma_Warning (A_Id) := False;
end if;
end Set_Restriction_No_Use_Of_Pragma;
----------------------------------
-- Suppress_Restriction_Message --
----------------------------------

25
gcc/ada/restrict.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- 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- --
@ -252,6 +252,16 @@ package Restrict is
-- Wrapper on Check_Restriction with Msg_Issued, with the out-parameter
-- being ignored here.
procedure Check_Restriction_No_Use_Of_Attribute (N : Node_Id);
-- N is the node of an attribute definition clause. An error message
-- (warning) will be issued if a restriction (warning) was previously set
-- for this attribute using Set_No_Use_Of_Attribute.
procedure Check_Restriction_No_Use_Of_Pragma (N : Node_Id);
-- N is the node of a pragma. An error message (warning) will be issued
-- if a restriction (warning) was previously set for this pragma using
-- Set_No_Use_Of_Pragma.
procedure Check_Restriction_No_Dependence (U : Node_Id; Err : Node_Id);
-- Called when a dependence on a unit is created (either implicitly, or by
-- an explicit WITH clause). U is a node for the unit involved, and Err is
@ -416,6 +426,19 @@ package Restrict is
-- case of a Restriction_Warnings pragma specifying this restriction and
-- False for a Restrictions pragma specifying this restriction.
procedure Set_Restriction_No_Use_Of_Attribute
(N : Node_Id;
Warning : Boolean);
-- N is the node id for the identifier in a pragma Restrictions for
-- No_Use_Of_Attribute. Caller has verified that this is a valid attribute
-- designator.
procedure Set_Restriction_No_Use_Of_Pragma
(N : Node_Id;
Warning : Boolean);
-- N is the node id for the identifier in a pragma Restrictions for
-- No_Use_Of_Pragma. Caller has verified that this is a valid pragma id.
function Tasking_Allowed return Boolean;
pragma Inline (Tasking_Allowed);
-- Tests if tasking operations are allowed by the current restrictions

164
gcc/ada/s-rident.ads
View File

@ -88,69 +88,71 @@ package System.Rident is
-- binder will check that every unit either has the restriction set, or
-- does not violate the restriction.
(Simple_Barriers, -- GNAT (Ravenscar)
No_Abort_Statements, -- (RM D.7(5), H.4(3))
No_Access_Subprograms, -- (RM H.4(17))
No_Allocators, -- (RM H.4(7))
No_Allocators_After_Elaboration, -- Ada 2012 (RM D.7(19.1/2))
No_Anonymous_Allocators, -- Ada 2012 (RM H.4(8/1))
No_Asynchronous_Control, -- (RM J.13(3/2)
No_Calendar, -- GNAT
No_Default_Stream_Attributes, -- Ada 2012 (RM 13.12.1(4/2))
No_Delay, -- (RM H.4(21))
No_Direct_Boolean_Operators, -- GNAT
No_Dispatch, -- (RM H.4(19))
No_Dispatching_Calls, -- GNAT
No_Dynamic_Attachment, -- GNAT
No_Dynamic_Priorities, -- (RM D.9(9))
No_Enumeration_Maps, -- GNAT
No_Entry_Calls_In_Elaboration_Code, -- GNAT
No_Entry_Queue, -- GNAT (Ravenscar)
No_Exception_Handlers, -- GNAT
No_Exception_Propagation, -- GNAT
No_Exception_Registration, -- GNAT
No_Exceptions, -- (RM H.4(12))
No_Finalization, -- GNAT
No_Fixed_Point, -- (RM H.4(15))
No_Floating_Point, -- (RM H.4(14))
No_IO, -- (RM H.4(20))
No_Implicit_Conditionals, -- GNAT
No_Implicit_Dynamic_Code, -- GNAT
No_Implicit_Heap_Allocations, -- (RM D.8(8), H.4(3))
No_Implicit_Loops, -- GNAT
No_Initialize_Scalars, -- GNAT
No_Local_Allocators, -- (RM H.4(8))
No_Local_Timing_Events, -- (RM D.7(10.2/2))
No_Local_Protected_Objects, -- GNAT
No_Nested_Finalization, -- (RM D.7(4))
No_Protected_Type_Allocators, -- GNAT
No_Protected_Types, -- (RM H.4(5))
No_Recursion, -- (RM H.4(22))
No_Reentrancy, -- (RM H.4(23))
No_Relative_Delay, -- GNAT (Ravenscar)
No_Requeue_Statements, -- GNAT
No_Secondary_Stack, -- GNAT
No_Select_Statements, -- GNAT (Ravenscar)
No_Specific_Termination_Handlers, -- (RM D.7(10.7/2))
No_Standard_Storage_Pools, -- GNAT
No_Stream_Optimizations, -- GNAT
No_Streams, -- GNAT
No_Task_Allocators, -- (RM D.7(7))
No_Task_Attributes_Package, -- GNAT
No_Task_Hierarchy, -- (RM D.7(3), H.4(3))
No_Task_Termination, -- GNAT (Ravenscar)
No_Tasking, -- GNAT
No_Terminate_Alternatives, -- (RM D.7(6))
No_Unchecked_Access, -- (RM H.4(18))
No_Unchecked_Conversion, -- (RM J.13(4/2))
No_Unchecked_Deallocation, -- (RM J.13(5/2))
Static_Priorities, -- GNAT
Static_Storage_Size, -- GNAT
(Simple_Barriers, -- Ada 2012 (D.7 (10.9/3))
No_Abort_Statements, -- (RM D.7(5), H.4(3))
No_Access_Parameter_Allocators, -- Ada 2012 (RM H.4 (8.3/3))
No_Access_Subprograms, -- (RM H.4(17))
No_Allocators, -- (RM H.4(7))
No_Anonymous_Allocators, -- Ada 2012 (RM H.4(8/1))
No_Asynchronous_Control, -- (RM J.13(3/2)
No_Calendar, -- GNAT
No_Coextensions, -- Ada 2012 (RM H.4(8.2/3))
No_Default_Stream_Attributes, -- Ada 2012 (RM 13.12.1(4/2))
No_Delay, -- (RM H.4(21))
No_Direct_Boolean_Operators, -- GNAT
No_Dispatch, -- (RM H.4(19))
No_Dispatching_Calls, -- GNAT
No_Dynamic_Attachment, -- Ada 2012 (RM E.7(10/3))
No_Dynamic_Priorities, -- (RM D.9(9))
No_Enumeration_Maps, -- GNAT
No_Entry_Calls_In_Elaboration_Code, -- GNAT
No_Entry_Queue, -- GNAT (Ravenscar)
No_Exception_Handlers, -- GNAT
No_Exception_Propagation, -- GNAT
No_Exception_Registration, -- GNAT
No_Exceptions, -- (RM H.4(12))
No_Finalization, -- GNAT
No_Fixed_Point, -- (RM H.4(15))
No_Floating_Point, -- (RM H.4(14))
No_IO, -- (RM H.4(20))
No_Implicit_Conditionals, -- GNAT
No_Implicit_Dynamic_Code, -- GNAT
No_Implicit_Heap_Allocations, -- (RM D.8(8), H.4(3))
No_Implicit_Loops, -- GNAT
No_Initialize_Scalars, -- GNAT
No_Local_Allocators, -- (RM H.4(8))
No_Local_Timing_Events, -- (RM D.7(10.2/2))
No_Local_Protected_Objects, -- Ada 2012 (D.7(10/1.3))
No_Nested_Finalization, -- (RM D.7(4))
No_Protected_Type_Allocators, -- Ada 2012 (D.7 (10.3/2))
No_Protected_Types, -- (RM H.4(5))
No_Recursion, -- (RM H.4(22))
No_Reentrancy, -- (RM H.4(23))
No_Relative_Delay, -- Ada 2012 (D.7 (10.5/3))
No_Requeue_Statements, -- Ada 2012 (D.7 (10.6/3))
No_Secondary_Stack, -- GNAT
No_Select_Statements, -- Ada 2012 (D.7 (10.7/4))
No_Specific_Termination_Handlers, -- (RM D.7(10.7/2))
No_Standard_Allocators_After_Elaboration, -- Ada 2012 (RM D.7(19.1/2))
No_Standard_Storage_Pools, -- GNAT
No_Stream_Optimizations, -- GNAT
No_Streams, -- GNAT
No_Task_Allocators, -- (RM D.7(7))
No_Task_Attributes_Package, -- GNAT
No_Task_Hierarchy, -- (RM D.7(3), H.4(3))
No_Task_Termination, -- GNAT (Ravenscar)
No_Tasking, -- GNAT
No_Terminate_Alternatives, -- (RM D.7(6))
No_Unchecked_Access, -- (RM H.4(18))
No_Unchecked_Conversion, -- (RM J.13(4/2))
No_Unchecked_Deallocation, -- (RM J.13(5/2))
Static_Priorities, -- GNAT
Static_Storage_Size, -- GNAT
-- The following require consistency checking with special rules. See
-- individual routines in unit Bcheck for details of what is required.
No_Default_Initialization, -- GNAT
No_Default_Initialization, -- GNAT
-- The following cases do not require consistency checking and if used
-- as a configuration pragma within a specific unit, apply only to that
@ -162,30 +164,34 @@ package System.Rident is
-- it is sticky, in that if it is found anywhere within any of these
-- units, it applies to all units in this extended main source.
Immediate_Reclamation, -- (RM H.4(10))
No_Implementation_Aspect_Specifications, -- Ada 2012 AI-241
No_Implementation_Attributes, -- Ada 2005 AI-257
No_Implementation_Identifiers, -- Ada 2012 AI-246
No_Implementation_Pragmas, -- Ada 2005 AI-257
No_Implementation_Restrictions, -- GNAT
No_Implementation_Units, -- Ada 2012 AI-242
No_Implicit_Aliasing, -- GNAT
No_Elaboration_Code, -- GNAT
No_Obsolescent_Features, -- Ada 2005 AI-368
No_Wide_Characters, -- GNAT
SPARK, -- GNAT
Immediate_Reclamation, -- (RM H.4(10))
No_Implementation_Aspect_Specifications, -- Ada 2012 AI-241
No_Implementation_Attributes, -- Ada 2005 AI-257
No_Implementation_Identifiers, -- Ada 2012 AI-246
No_Implementation_Pragmas, -- Ada 2005 AI-257
No_Implementation_Restrictions, -- GNAT
No_Implementation_Units, -- Ada 2012 AI-242
No_Implicit_Aliasing, -- GNAT
No_Elaboration_Code, -- GNAT
No_Obsolescent_Features, -- Ada 2005 AI-368
No_Wide_Characters, -- GNAT
SPARK, -- GNAT
-- The following cases require a parameter value
No_Specification_Of_Aspect, -- 2012 (RM 13.12.1 (6.1/3))
No_Use_Of_Attribute, -- 2012 (RM 13.12.1 (6.2/3))
No_Use_Of_Pragma, -- 2012 (RM 13.12.1 (6.3/3))
-- The following entries are fully checked at compile/bind time, which
-- means that the compiler can in general tell the minimum value which
-- could be used with a restrictions pragma. The binder can deduce the
-- appropriate minimum value for the partition by taking the maximum
-- value required by any unit.
Max_Protected_Entries, -- (RM D.7(14))
Max_Select_Alternatives, -- (RM D.7(12))
Max_Task_Entries, -- (RM D.7(13), H.4(3))
Max_Protected_Entries, -- (RM D.7(14))
Max_Select_Alternatives, -- (RM D.7(12))
Max_Task_Entries, -- (RM D.7(13), H.4(3))
-- The following entries are also fully checked at compile/bind time,
-- and the compiler can also at least in some cases tell the minimum
@ -193,19 +199,19 @@ package System.Rident is
-- is that the contributions are additive, so the binder deduces this
-- value by adding the unit contributions.
Max_Tasks, -- (RM D.7(19), H.4(3))
Max_Tasks, -- (RM D.7(19), H.4(3))
-- The following entries are checked at compile time only for zero/
-- nonzero entries. This means that the compiler can tell at compile
-- time if a restriction value of zero is (would be) violated, but that
-- the compiler cannot distinguish between different non-zero values.
Max_Asynchronous_Select_Nesting, -- (RM D.7(18), H.4(3))
Max_Entry_Queue_Length, -- GNAT
Max_Asynchronous_Select_Nesting, -- (RM D.7(18), H.4(3))
Max_Entry_Queue_Length, -- Ada 2012 (RM D.7 (19.1/2))
-- The remaining entries are not checked at compile/bind time
Max_Storage_At_Blocking, -- (RM D.7(17))
Max_Storage_At_Blocking, -- (RM D.7(17))
Not_A_Restriction_Id);
@ -242,7 +248,7 @@ package System.Rident is
subtype All_Parameter_Restrictions is
Restriction_Id range
Max_Protected_Entries .. Max_Storage_At_Blocking;
No_Specification_Of_Aspect .. Max_Storage_At_Blocking;
-- All restrictions that take a parameter
subtype Checked_Parameter_Restrictions is

1
gcc/ada/sem_ch13.adb
View File

@ -2770,6 +2770,7 @@ package body Sem_Ch13 is
end if;
Set_Entity (N, U_Ent);
Check_Restriction_No_Use_Of_Attribute (N);
-- Switch on particular attribute

8
gcc/ada/sem_ch4.adb
View File

@ -413,8 +413,9 @@ package body Sem_Ch4 is
if Comes_From_Source (N) then
Check_Restriction (No_Allocators, N);
-- Processing for No_Allocators_After_Elaboration, loop to look at
-- enclosing context, checking task case and main subprogram case.
-- Processing for No_Standard_Allocators_After_Elaboration, loop to
-- look at enclosing context, checking task case and main subprogram
-- case.
C := N;
P := Parent (C);
@ -431,7 +432,8 @@ package body Sem_Ch4 is
-- violation of No_Allocators_After_Elaboration we can detect.
if Nkind (Original_Node (Parent (P))) = N_Task_Body then
Check_Restriction (No_Allocators_After_Elaboration, N);
Check_Restriction
(No_Standard_Allocators_After_Elaboration, N);
exit;
end if;

22
gcc/ada/sem_prag.adb
View File

@ -5801,6 +5801,26 @@ package body Sem_Prag is
end if;
end;
elsif Id = Name_No_Use_Of_Attribute then
if Nkind (Expr) /= N_Identifier
or else not Is_Attribute_Name (Chars (Expr))
then
Error_Msg_N ("unknown attribute name?", Expr);
else
Set_Restriction_No_Use_Of_Attribute (Expr, Warn);
end if;
elsif Id = Name_No_Use_Of_Pragma then
if Nkind (Expr) /= N_Identifier
or else not Is_Pragma_Name (Chars (Expr))
then
Error_Msg_N ("unknown pragma name?", Expr);
else
Set_Restriction_No_Use_Of_Pragma (Expr, Warn);
end if;
-- All other cases of restriction identifier present
else
@ -6757,6 +6777,8 @@ package body Sem_Prag is
end if;
end if;
Check_Restriction_No_Use_Of_Pragma (N);
-- An enumeration type defines the pragmas that are supported by the
-- implementation. Get_Pragma_Id (in package Prag) transforms a name
-- into the corresponding enumeration value for the following case.

6
gcc/ada/sem_res.adb
View File

@ -3667,6 +3667,10 @@ package body Sem_Res is
Establish_Transient_Scope (A, False);
end if;
end;
if Ekind (Etype (F)) = E_Anonymous_Access_Type then
Check_Restriction (No_Access_Parameter_Allocators, A);
end if;
end if;
-- (Ada 2005): The call may be to a primitive operation of
@ -4552,6 +4556,8 @@ package body Sem_Res is
Defining_Identifier (Associated_Node_For_Itype (Typ));
begin
Check_Restriction (No_Coextensions, N);
-- Ada 2012 AI05-0052: If the designated type of the allocator
-- is limited, then the allocator shall not be used to define
-- the value of an access discriminant unless the discriminated

5
gcc/ada/snames.ads-tmpl
View File

@ -721,6 +721,8 @@ package Snames is
Name_Name : constant Name_Id := N + $;
Name_NCA : constant Name_Id := N + $;
Name_No : constant Name_Id := N + $;
Name_No_Access_Parameter_Allocators : constant Name_Id := N + $;
Name_No_Coextensions : constant Name_Id := N + $;
Name_No_Dependence : constant Name_Id := N + $;
Name_No_Dynamic_Attachment : constant Name_Id := N + $;
Name_No_Dynamic_Interrupts : constant Name_Id := N + $;
@ -728,8 +730,11 @@ package Snames is
Name_No_Requeue : constant Name_Id := N + $;
Name_No_Requeue_Statements : constant Name_Id := N + $;
Name_No_Specification_Of_Aspect : constant Name_Id := N + $;
Name_No_Standard_Allocators_After_Elaboration : constant Name_Id := N + $;
Name_No_Task_Attributes : constant Name_Id := N + $;
Name_No_Task_Attributes_Package : constant Name_Id := N + $;
Name_No_Use_Of_Attribute : constant Name_Id := N + $;
Name_No_Use_Of_Pragma : constant Name_Id := N + $;
Name_No_Unroll : constant Name_Id := N + $;
Name_No_Vector : constant Name_Id := N + $;
Name_Nominal : constant Name_Id := N + $;