From patchwork Fri Jun 13 10:02:41 2014 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 359478 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.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id C01371400EA for ; Fri, 13 Jun 2014 20:02:52 +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=thmC/SNT+pGYoNs6kRFBIbM8yVuYVwuiI0EJOyZkUrbhe1Zaap OT9/lAI6GWzSvQkLsKQ4n3UgSxsuOX9EQ82MPlVS+QAJSnYyY/o9D9vdWlWvKMRT tRoWA8eO2t/WwsMK3B3ugtJx/JTJh/kHvqS8roN5rT2IZXYHSXYrYFEn0= 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=FaIupqhgXrGGzHvmLEe2pGpyrZs=; b=Cw5PnWk/jQe2xTNwPsn3 jdUG0aAfntcxg3eLeeaRUqcF4vfCNuWBl6x8Kuwdmva4e2Wc3ffTf/XT5V/wcf9y 5zWobHDHMpbMfSwbSGnMiPEd1A+EFH5QzmrDiclTcud8Wp6/YmpWXhoVf12WsWAq bwBYb3Hoj4WWZjmy/717qc0= Received: (qmail 1237 invoked by alias); 13 Jun 2014 10:02:45 -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 1224 invoked by uid 89); 13 Jun 2014 10:02:45 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham version=3.3.2 X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-SHA encrypted) ESMTPS; Fri, 13 Jun 2014 10:02:43 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id AF2A3116119; Fri, 13 Jun 2014 06:02:41 -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 UNtyvYuRRSSf; Fri, 13 Jun 2014 06:02:41 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [IPv6:2620:20:4000:0:a6ba:dbff:fe26:1f63]) by rock.gnat.com (Postfix) with ESMTP id 9E8E21160CE; Fri, 13 Jun 2014 06:02:41 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id 9B20C91976; Fri, 13 Jun 2014 06:02:41 -0400 (EDT) Date: Fri, 13 Jun 2014 06:02:41 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Robert Dewar Subject: [Ada] Improvements to handling of pragma Compiler_Unit_Warning Message-ID: <20140613100241.GA32275@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.21 (2010-09-15) We now check for null statement sequences, and for extended return statements. In addition, the message generated now includes a description of the non-permitted construct as shown in this test program (compiled with -gnatj60 -gnatl) 1. pragma Ada_2012; 2. pragma Compiler_Unit_Warning; 3. function CompUnitER return Integer is 4. begin 5. begin 6. pragma List (On); 7. end; | >>> warning: null statement list not allowed in compiler unit 8. return X : Integer do | >>> warning: extended return statement not allowed in compiler unit 9. X := 3; 10. end return; 11. end; Tested on x86_64-pc-linux-gnu, committed on trunk 2014-06-13 Robert Dewar * lib.ads, lib.adb, lib-writ.adb, lib-load.adb (Is_Compiler_Unit): Removed. * opt.ads (Compiler_Unit): New flag. * par-ch5.adb (Test_Statement_Required): Call Check_Compiler_Unit for null statement sequence (not allowed in compiler unit). * par-prag.adb (Prag): Handle Compiler_Unit[_Warning] during parsing. * restrict.ads, restrict.adb (Check_Compiler_Unit): New version and new calling sequence. * sem_ch11.adb, sem_ch3.adb, sem_ch4.adb: New calling sequence for Check_Compiler_Unit. * sem_ch6.adb (Analyze_Extended_Return_Statement): Call Check_Compiler_Unit (this construct is not allowed in compiler units). * sem_prag.adb (Analyze_Pragma, case Compiler_Unit[_Warning]): Set Opt.Compiler_Unit. Index: lib.adb =================================================================== --- lib.adb (revision 211615) +++ lib.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, 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- -- @@ -126,11 +126,6 @@ return Units.Table (U).Has_RACW; end Has_RACW; - function Is_Compiler_Unit (U : Unit_Number_Type) return Boolean is - begin - return Units.Table (U).Is_Compiler_Unit; - end Is_Compiler_Unit; - function Ident_String (U : Unit_Number_Type) return Node_Id is begin return Units.Table (U).Ident_String; @@ -221,14 +216,6 @@ Units.Table (U).Has_RACW := B; end Set_Has_RACW; - procedure Set_Is_Compiler_Unit - (U : Unit_Number_Type; - B : Boolean := True) - is - begin - Units.Table (U).Is_Compiler_Unit := B; - end Set_Is_Compiler_Unit; - procedure Set_Ident_String (U : Unit_Number_Type; N : Node_Id) is begin Units.Table (U).Ident_String := N; Index: sem_ch3.adb =================================================================== --- sem_ch3.adb (revision 211615) +++ sem_ch3.adb (working copy) @@ -836,7 +836,7 @@ -- the runtime library but must also be compilable in Ada 95 mode -- (when bootstrapping the compiler). - Check_Compiler_Unit (N); + Check_Compiler_Unit ("anonymous access to subprogram", N); Access_Subprogram_Declaration (T_Name => Anon_Type, Index: lib.ads =================================================================== --- lib.ads (revision 211615) +++ lib.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, 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- -- @@ -326,10 +326,6 @@ -- (RACW) object. This is used for controlling generation of the RA -- attribute in the ali file. - -- Is_Compiler_Unit - -- A Boolean flag, initially set False by default, set to True if a - -- pragma Compiler_Unit_Warning appears in the unit. - -- Ident_String -- N_String_Literal node from a valid pragma Ident that applies to -- this unit. If no Ident pragma applies to the unit, then Empty. @@ -415,7 +411,6 @@ function Ident_String (U : Unit_Number_Type) return Node_Id; function Has_Allocator (U : Unit_Number_Type) return Boolean; function Has_RACW (U : Unit_Number_Type) return Boolean; - function Is_Compiler_Unit (U : Unit_Number_Type) return Boolean; function Loading (U : Unit_Number_Type) return Boolean; function Main_CPU (U : Unit_Number_Type) return Int; function Main_Priority (U : Unit_Number_Type) return Int; @@ -434,7 +429,6 @@ procedure Set_Generate_Code (U : Unit_Number_Type; B : Boolean := True); procedure Set_Has_RACW (U : Unit_Number_Type; B : Boolean := True); procedure Set_Has_Allocator (U : Unit_Number_Type; B : Boolean := True); - procedure Set_Is_Compiler_Unit (U : Unit_Number_Type; B : Boolean := True); procedure Set_Ident_String (U : Unit_Number_Type; N : Node_Id); procedure Set_Loading (U : Unit_Number_Type; B : Boolean := True); procedure Set_Main_CPU (U : Unit_Number_Type; P : Int); @@ -734,7 +728,6 @@ pragma Inline (Generate_Code); pragma Inline (Has_Allocator); pragma Inline (Has_RACW); - pragma Inline (Is_Compiler_Unit); pragma Inline (Increment_Serial_Number); pragma Inline (Loading); pragma Inline (Main_CPU); @@ -774,8 +767,8 @@ Fatal_Error : Boolean; Generate_Code : Boolean; Has_RACW : Boolean; - Is_Compiler_Unit : Boolean; Dynamic_Elab : Boolean; + Filler : Boolean; Loading : Boolean; Has_Allocator : Boolean; OA_Setting : Character; @@ -805,7 +798,7 @@ Generate_Code at 57 range 0 .. 7; Has_RACW at 58 range 0 .. 7; Dynamic_Elab at 59 range 0 .. 7; - Is_Compiler_Unit at 60 range 0 .. 7; + Filler at 60 range 0 .. 7; OA_Setting at 61 range 0 .. 7; Loading at 62 range 0 .. 7; Has_Allocator at 63 range 0 .. 7; Index: lib-writ.adb =================================================================== --- lib-writ.adb (revision 211615) +++ lib-writ.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, 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- -- @@ -84,7 +84,7 @@ Generate_Code => False, Has_Allocator => False, Has_RACW => False, - Is_Compiler_Unit => False, + Filler => False, Ident_String => Empty, Loading => False, Main_Priority => -1, @@ -142,7 +142,7 @@ Generate_Code => False, Has_Allocator => False, Has_RACW => False, - Is_Compiler_Unit => False, + Filler => False, Ident_String => Empty, Loading => False, Main_Priority => -1, Index: sem_prag.adb =================================================================== --- sem_prag.adb (revision 211616) +++ sem_prag.adb (working copy) @@ -12409,8 +12409,13 @@ when Pragma_Compiler_Unit | Pragma_Compiler_Unit_Warning => GNAT_Pragma; Check_Arg_Count (0); - Set_Is_Compiler_Unit (Get_Source_Unit (N)); + -- Only recognized in main unit + + if Current_Sem_Unit = Main_Unit then + Compiler_Unit := True; + end if; + ----------------------------- -- Complete_Representation -- ----------------------------- @@ -21346,7 +21351,7 @@ -- Not allowed in compiler units (bootstrap issues) - Check_Compiler_Unit (N); + Check_Compiler_Unit ("Reason for pragma Warnings", N); -- No REASON string, set null string as reason Index: sem_ch4.adb =================================================================== --- sem_ch4.adb (revision 211615) +++ sem_ch4.adb (working copy) @@ -1392,7 +1392,7 @@ begin if Comes_From_Source (N) then - Check_Compiler_Unit (N); + Check_Compiler_Unit ("case expression", N); end if; Analyze_And_Resolve (Expr, Any_Discrete); @@ -2077,7 +2077,7 @@ Else_Expr := Next (Then_Expr); if Comes_From_Source (N) then - Check_Compiler_Unit (N); + Check_Compiler_Unit ("if expression", N); end if; Analyze_Expression (Condition); @@ -2669,7 +2669,7 @@ begin if Comes_From_Source (N) then - Check_Compiler_Unit (N); + Check_Compiler_Unit ("set membership", N); end if; Analyze (L); @@ -7038,7 +7038,7 @@ -- a dereference operation. if Comes_From_Source (N) then - Check_Compiler_Unit (N); + Check_Compiler_Unit ("generalized indexing", N); end if; declare Index: restrict.adb =================================================================== --- restrict.adb (revision 211615) +++ restrict.adb (working copy) @@ -168,13 +168,20 @@ -- Check_Compiler_Unit -- ------------------------- - procedure Check_Compiler_Unit (N : Node_Id) is + procedure Check_Compiler_Unit (Feature : String; N : Node_Id) is begin - if Is_Compiler_Unit (Get_Source_Unit (N)) then - Error_Msg_N ("use of construct not allowed in compiler!!??", N); + if Compiler_Unit then + Error_Msg_N (Feature & " not allowed in compiler unit!!??", N); end if; end Check_Compiler_Unit; + procedure Check_Compiler_Unit (Feature : String; Loc : Source_Ptr) is + begin + if Compiler_Unit then + Error_Msg (Feature & " not allowed in compiler unit!!??", Loc); + end if; + end Check_Compiler_Unit; + ------------------------------------ -- Check_Elaboration_Code_Allowed -- ------------------------------------ Index: restrict.ads =================================================================== --- restrict.ads (revision 211615) +++ restrict.ads (working copy) @@ -192,11 +192,16 @@ -- For abort to be allowed, either No_Abort_Statements must be False, -- or Max_Asynchronous_Select_Nesting must be non-zero. - procedure Check_Compiler_Unit (N : Node_Id); - -- If unit N is in a unit that has a pragma Compiler_Unit, then a message - -- is posted on node N noting use of a construct that is not permitted in - -- the compiler. + procedure Check_Compiler_Unit (Feature : String; N : Node_Id); + -- If unit N is in a unit that has a pragma Compiler_Unit_Warning, then + -- a message is posted on node N noting use of the given feature is not + -- permitted in the compiler (bootstrap considerations). + procedure Check_Compiler_Unit (Feature : String; Loc : Source_Ptr); + -- If unit N is in a unit that has a pragma Compiler_Unit_Warning, then a + -- message is posted at location Loc noting use of the given feature is not + -- permitted in the compiler (bootstrap considerations). + procedure Check_Restricted_Unit (U : Unit_Name_Type; N : Node_Id); -- Checks if loading of unit U is prohibited by the setting of some -- restriction (e.g. No_IO restricts the loading of unit Ada.Text_IO). Index: lib-load.adb =================================================================== --- lib-load.adb (revision 211615) +++ lib-load.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, 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- -- @@ -216,7 +216,7 @@ Generate_Code => False, Has_Allocator => False, Has_RACW => False, - Is_Compiler_Unit => False, + Filler => False, Ident_String => Empty, Loading => False, Main_Priority => Default_Main_Priority, @@ -323,7 +323,7 @@ Generate_Code => False, Has_Allocator => False, Has_RACW => False, - Is_Compiler_Unit => False, + Filler => False, Ident_String => Empty, Loading => True, Main_Priority => Default_Main_Priority, @@ -687,7 +687,7 @@ Generate_Code => False, Has_Allocator => False, Has_RACW => False, - Is_Compiler_Unit => False, + Filler => False, Ident_String => Empty, Loading => True, Main_Priority => Default_Main_Priority, Index: sem_ch6.adb =================================================================== --- sem_ch6.adb (revision 211615) +++ sem_ch6.adb (working copy) @@ -525,6 +525,7 @@ procedure Analyze_Extended_Return_Statement (N : Node_Id) is begin + Check_Compiler_Unit ("extended return statement", N); Analyze_Return_Statement (N); end Analyze_Extended_Return_Statement; Index: par-prag.adb =================================================================== --- par-prag.adb (revision 211615) +++ par-prag.adb (working copy) @@ -354,6 +354,22 @@ Ada_Version_Pragma := Pragma_Node; end if; + --------------------------- + -- Compiler_Unit_Warning -- + --------------------------- + + -- This pragma must be processed at parse time, since the resulting + -- status may be tested during the parsing of the program. + + when Pragma_Compiler_Unit | Pragma_Compiler_Unit_Warning => + Check_Arg_Count (0); + + -- Only recognized in main unit + + if Current_Source_Unit = Main_Unit then + Compiler_Unit := True; + end if; + ----------- -- Debug -- ----------- @@ -1153,8 +1169,6 @@ Pragma_CIL_Constructor | Pragma_Compile_Time_Error | Pragma_Compile_Time_Warning | - Pragma_Compiler_Unit | - Pragma_Compiler_Unit_Warning | Pragma_Contract_Cases | Pragma_Convention_Identifier | Pragma_CPP_Class | Index: sem_ch11.adb =================================================================== --- sem_ch11.adb (revision 211615) +++ sem_ch11.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, 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- -- @@ -436,7 +436,7 @@ begin if Comes_From_Source (N) then - Check_Compiler_Unit (N); + Check_Compiler_Unit ("raise expression", N); end if; Check_SPARK_Restriction ("raise expression is not allowed", N); Index: opt.ads =================================================================== --- opt.ads (revision 211615) +++ opt.ads (working copy) @@ -375,6 +375,15 @@ -- set to True to delete only the files produced by the compiler but not -- the library files or the executable files. + Compiler_Unit : Boolean := False; + -- GNAT1 + -- Set True by an occurrence of pragma Compiler_Unit_Warning (or of the + -- obsolete pragma Compiler_Unit) in the main unit. Once set True, stays + -- True, since any units that are with'ed directly or indirectly by + -- a Compiler_Unit_Warning main unit are subject to the same restrictions. + -- Such units really should have their own pragmas, but we do not bother to + -- check for that, so this transitivity provides extra checking. + Config_File : Boolean := True; -- GNAT -- Set to False to inhibit reading and processing of gnat.adc file Index: par-ch5.adb =================================================================== --- par-ch5.adb (revision 211615) +++ par-ch5.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, 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- -- @@ -240,6 +240,10 @@ and then Statement_Seen) or else All_Pragmas) then + -- This Ada 2012 construct not allowed in a compiler unit + + Check_Compiler_Unit ("null statement list", Token_Ptr); + declare Null_Stm : constant Node_Id := Make_Null_Statement (Token_Ptr);