From patchwork Fri Apr 12 13:12:10 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 236086 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (Client CN "localhost", Issuer "www.qmailtoaster.com" (not verified)) by ozlabs.org (Postfix) with ESMTPS id 4DF6B2C00A7 for ; Fri, 12 Apr 2013 23:12:22 +1000 (EST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=Nz/YgSjxifxzqc6f3XoSWWJPqOESCj1uQPBps8RPkQSoVHiiSB RnWn6nsiybzNEoS1EyWgeqgXtg9yag8/GezeVzD3XRJgiiLJ3abDQaRn7K/Kbie/ y/H55ePQG/ZwdqB3Gpl4Aap2vmK3NujvFTyajP5lMMboNmNQddTsW2AtI= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=UE5PTz/dceydGj2sCopN479H3Qg=; b=mtGWoEEgQyeze03bEWAk 99ny8O/B3DmT1RyuWFazjQtfpe9wbdpo+O0VY8kVQ+MUOgQE0oICrkCfstIwNg+j sFNa17lgj4cBOR1vrozBILmLT4j7BQhpqZOjD2eVwRSo/mJ7LXds27pLDN9jlZjs m98Gui8isFqszSpNBUdB9Iw= Received: (qmail 9619 invoked by alias); 12 Apr 2013 13:12:14 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 9609 invoked by uid 89); 12 Apr 2013 13:12:14 -0000 X-Spam-SWARE-Status: No, score=-1.8 required=5.0 tests=AWL, BAYES_00, RCVD_IN_HOSTKARMA_NO autolearn=ham version=3.3.1 Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.84/v0.84-167-ge50287c) with ESMTP; Fri, 12 Apr 2013 13:12:12 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 0F4012EAE2; Fri, 12 Apr 2013 09:12:11 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id x6EjJzqhLfZ3; Fri, 12 Apr 2013 09:12:10 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id E5ACF2E0E8; Fri, 12 Apr 2013 09:12:10 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id DF0473FF09; Fri, 12 Apr 2013 09:12:10 -0400 (EDT) Date: Fri, 12 Apr 2013 09:12:10 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Completing the implementation of Ada 2012 restrictions Message-ID: <20130412131210.GA25559@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) X-Virus-Found: No This patch adds several restrictions identifiers that were introduced late in the Ada 2012 development process. Given the following configuration file: --- pragma Restrictions (No_Access_Parameter_Allocators, No_Coextensions); pragma Restrictions (No_Standard_Allocators_After_Elaboration); pragma Restrictions (No_Use_Of_Attribute => Address); pragma Restrictions (No_Use_Of_Pragma => Pure); --- compiling main.adb below must yield: main.adb:2:11: violation of restriction "No_Use_Of_Pragma => Pure" at gnat.adc:4 main.adb:12:23: violation of restriction "No_Coextensions" at gnat.adc:1 main.adb:13:04: violation of restriction "No_Use_Of_Attribute => Address" at gnat.adc:3 main.adb:15:15: violation of restriction "No_Access_Parameter_Allocators" at gnat.adc:1 --- procedure Main is pragma Pure; type T (X : access Integer) is record Value : Integer; end record; function Double (X : access integer) return Integer is begin return X.all * 2; end; Here : Integer; Thing : T := (X => new Integer'(123), Value => -1); for Thing'address use here'address; begin if Double (new Integer'(111)) /= 222 then Raise Program_Error; end if; end; Tested on x86_64-pc-linux-gnu, committed on trunk 2013-04-12 Ed Schonberg * 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. Index: sem_prag.adb =================================================================== --- sem_prag.adb (revision 197906) +++ sem_prag.adb (working copy) @@ -5801,6 +5801,26 @@ 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 @@ 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. Index: sem_res.adb =================================================================== --- sem_res.adb (revision 197899) +++ sem_res.adb (working copy) @@ -3667,6 +3667,10 @@ 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 @@ 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 Index: sem_ch4.adb =================================================================== --- sem_ch4.adb (revision 197899) +++ sem_ch4.adb (working copy) @@ -413,8 +413,9 @@ 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 @@ -- 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; Index: restrict.adb =================================================================== --- restrict.adb (revision 197899) +++ restrict.adb (working copy) @@ -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 @@ -- 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 @@ 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 + (" &`#", + Id); + end if; + end Check_Restriction_No_Use_Of_Pragma; + ----------------------------------- -- Check_Obsolescent_2005_Entity -- ----------------------------------- @@ -1271,6 +1357,44 @@ 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 -- ---------------------------------- Index: restrict.ads =================================================================== --- restrict.ads (revision 197899) +++ restrict.ads (working copy) @@ -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 @@ -- 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 @@ -- 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 Index: gnatbind.adb =================================================================== --- gnatbind.adb (revision 197899) +++ gnatbind.adb (working copy) @@ -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 @@ -- 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, Index: s-rident.ads =================================================================== --- s-rident.ads (revision 197899) +++ s-rident.ads (working copy) @@ -88,69 +88,71 @@ -- 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 @@ -- 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 @@ -- 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 @@ 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 Index: sem_ch13.adb =================================================================== --- sem_ch13.adb (revision 197901) +++ sem_ch13.adb (working copy) @@ -2770,6 +2770,7 @@ end if; Set_Entity (N, U_Ent); + Check_Restriction_No_Use_Of_Attribute (N); -- Switch on particular attribute Index: bcheck.adb =================================================================== --- bcheck.adb (revision 197899) +++ bcheck.adb (working copy) @@ -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 @@ 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 Index: snames.ads-tmpl =================================================================== --- snames.ads-tmpl (revision 197899) +++ snames.ads-tmpl (working copy) @@ -721,6 +721,8 @@ 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 @@ 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 + $;