diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 22 | ||||
| -rw-r--r-- | gcc/ada/bcheck.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/gnatbind.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/restrict.adb | 126 | ||||
| -rw-r--r-- | gcc/ada/restrict.ads | 25 | ||||
| -rw-r--r-- | gcc/ada/s-rident.ads | 164 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 22 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/snames.ads-tmpl | 5 |
11 files changed, 300 insertions, 89 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0871311..cba7cf9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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): diff --git a/gcc/ada/bcheck.adb b/gcc/ada/bcheck.adb index 09354ec..7c81df9 100644 --- a/gcc/ada/bcheck.adb +++ b/gcc/ada/bcheck.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -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 diff --git a/gcc/ada/gnatbind.adb b/gcc/ada/gnatbind.adb index c53d67e..9e45139 100644 --- a/gcc/ada/gnatbind.adb +++ b/gcc/ada/gnatbind.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -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, diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb index d4acf1d..2e225f1 100644 --- a/gcc/ada/restrict.adb +++ b/gcc/ada/restrict.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -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 -- ---------------------------------- diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads index 54702ab..6da0cae 100644 --- a/gcc/ada/restrict.ads +++ b/gcc/ada/restrict.ads @@ -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 diff --git a/gcc/ada/s-rident.ads b/gcc/ada/s-rident.ads index fcdf2ad..66a8cf4 100644 --- a/gcc/ada/s-rident.ads +++ b/gcc/ada/s-rident.ads @@ -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 diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index d06398a..89364c3 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -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 diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index b7a7d93..a66b194 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -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; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index e4e9446..ee93885 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -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. diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 804f3b8..02a5cda 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -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 diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 0f0053f..05d11dd 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -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 + $; |