From patchwork Fri Sep 10 14:42:22 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 64399 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]) by ozlabs.org (Postfix) with SMTP id AD829B70DC for ; Sat, 11 Sep 2010 00:42:34 +1000 (EST) Received: (qmail 26074 invoked by alias); 10 Sep 2010 14:42:33 -0000 Received: (qmail 26058 invoked by uid 22791); 10 Sep 2010 14:42:30 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (212.99.106.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Fri, 10 Sep 2010 14:42:25 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id DE9F4CB0253; Fri, 10 Sep 2010 16:42:22 +0200 (CEST) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id PNt4fbWLoLsz; Fri, 10 Sep 2010 16:42:22 +0200 (CEST) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id CB3E5CB01D8; Fri, 10 Sep 2010 16:42:22 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id AD7B4D9BB4; Fri, 10 Sep 2010 16:42:22 +0200 (CEST) Date: Fri, 10 Sep 2010 16:42:22 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Robert Dewar Subject: [Ada] Generate style warnings for spec Message-ID: <20100910144222.GA21163@adacore.com> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.9i X-IsSubscribed: yes 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 This patch cleans up the handling of style warnings in other than the main unit, and fixes the problem of not giving such warnings for the spec of the main unit. Consider this example: package specerr is z : integer := (if (2 = 2) then 2 else 3); procedure p; end; package body specerr is procedure p is separate; s2 : integer := (if (2 = 2) then 2 else 3); end; separate (specerr) procedure p is begin if (2 = 3) then null; end if; end; When we compile specerr.adb with -gnatyx -gnat12, we should get three warnings: specerr.adb:3:24: warning: redundant parentheses specerr.ads:2:23: warning: redundant parentheses specerr-p.adb:4:07: warning: redundant parentheses The first was always there This patch gives the second warning previously missing A recent prior patch produces the third warning Tested on x86_64-pc-linux-gnu, committed on trunk 2010-09-10 Robert Dewar * errout.adb: Remove tests of Parsing_Main_Subunit, since this test is now done in In_Extended_Main_Source_Unit. * errout.ads (Compiler_State[_Type]): Moved from Errout to Lib (Parsing_Main_Subunit): Moved from Errout to Lib and renamed as Parsing_Main_Extended_Source. * frontend.adb: Set Parsing_Main_Extended_Source True for parsing main unit. * lib-load.adb (Load_Unit): Add PMES parameter Set PMES appropriately in all calls to Load_Unit * lib-load.ads (Load_Unit): Add PMES parameter * lib.adb (In_Extended_Main_Source_Unit): When called with Compiler_State set to Parsing, test new flag Compiling_Main_Extended_Source. * lib.ads (Compiler_State[_Type]): Moved from Errout to Lib (Parsing_Main_Subunit): Moved from Errout to Lib and renamed as Parsing_Main_Extended_Source * par-load.adb (Load): Set PMES properly in call to Load_Unit Index: lib.adb =================================================================== --- lib.adb (revision 164167) +++ lib.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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- -- @@ -701,11 +701,10 @@ package body Lib is Mloc : constant Source_Ptr := Sloc (Cunit (Main_Unit)); begin - -- If Mloc is not set, it means we are still parsing the main unit, - -- so everything so far is in the extended main source unit. + -- If parsing, then use the global flag to indicate result - if Mloc = No_Location then - return True; + if Compiler_State = Parsing then + return Parsing_Main_Extended_Source; -- Special value cases @@ -741,11 +740,10 @@ package body Lib is Mloc : constant Source_Ptr := Sloc (Cunit (Main_Unit)); begin - -- If Mloc is not set, it means we are still parsing the main unit, - -- so everything so far is in the extended main source unit. + -- If parsing, then use the global flag to indicate result - if Mloc = No_Location then - return True; + if Compiler_State = Parsing then + return Parsing_Main_Extended_Source; -- Special value cases Index: lib.ads =================================================================== --- lib.ads (revision 164167) +++ lib.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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- -- @@ -39,6 +39,16 @@ with Types; use Types; package Lib is + type Compiler_State_Type is (Parsing, Analyzing); + Compiler_State : Compiler_State_Type; + -- Indicates current state of compilation. This is used to implement the + -- function In_Extended_Main_Source_Unit. + + Parsing_Main_Extended_Source : Boolean := False; + -- Set True if we are currently parsing a file that is part of the main + -- extended source (the main unit, its spec, or one of its subunits). This + -- flag to implement In_Extended_Main_Source_Unit. + -------------------------------------------- -- General Approach to Library Management -- -------------------------------------------- Index: frontend.adb =================================================================== --- frontend.adb (revision 164181) +++ frontend.adb (working copy) @@ -121,12 +121,17 @@ begin Lib.Load.Load_Main_Source; - -- Return immediately if the main source could not be parsed + -- Return immediately if the main source could not be found if Sinput.Main_Source_File = No_Source_File then return; end if; + -- We set Parsing_Main_Extended_Source true here to cover processing of all + -- the configuration pragma files, as well as the main source unit itself. + + Parsing_Main_Extended_Source := True; + -- Read and process configuration pragma files if present declare @@ -229,9 +234,9 @@ begin Optimize_Alignment := 'T'; end if; - -- We have now processed the command line switches, and the gnat.adc - -- file, so this is the point at which we want to capture the values - -- of the configuration switches (see Opt for further details). + -- We have now processed the command line switches, and the configuration + -- pragma files, so this is the point at which we want to capture the + -- values of the configuration switches (see Opt for further details). Opt.Register_Opt_Config_Switches; @@ -252,6 +257,7 @@ begin -- semantics in any case). Discard_List (Par (Configuration_Pragmas => False)); + Parsing_Main_Extended_Source := False; -- The main unit is now loaded, and subunits of it can be loaded, -- without reporting spurious loading circularities. Index: par-load.adb =================================================================== --- par-load.adb (revision 164176) +++ par-load.adb (working copy) @@ -266,7 +266,8 @@ begin Required => False, Subunit => False, Error_Node => Curunit, - Corr_Body => Cur_Unum); + Corr_Body => Cur_Unum, + PMES => (Cur_Unum = Main_Unit)); -- If we successfully load the unit, then set the spec/body pointers. -- Once again note that if the loaded unit has a fatal error, Load will @@ -342,25 +343,17 @@ begin -- If current unit is a subunit, then load its parent body elsif Nkind (Unit (Curunit)) = N_Subunit then - declare - Save_PMS : constant Boolean := Parsing_Main_Subunit; - - begin - Parsing_Main_Subunit := False; - Body_Name := Get_Parent_Body_Name (Unit_Name (Cur_Unum)); - Unum := - Load_Unit - (Load_Name => Body_Name, - Required => True, - Subunit => False, - Error_Node => Name (Unit (Curunit))); - - if Unum /= No_Unit then - Set_Library_Unit (Curunit, Cunit (Unum)); - end if; + Body_Name := Get_Parent_Body_Name (Unit_Name (Cur_Unum)); + Unum := + Load_Unit + (Load_Name => Body_Name, + Required => True, + Subunit => False, + Error_Node => Name (Unit (Curunit))); - Parsing_Main_Subunit := Save_PMS; - end; + if Unum /= No_Unit then + Set_Library_Unit (Curunit, Cunit (Unum)); + end if; end if; -- Now we load with'ed units, with style/validity checks turned off Index: errout.adb =================================================================== --- errout.adb (revision 164176) +++ errout.adb (working copy) @@ -748,9 +748,7 @@ package body Errout is -- If the flag location is in the main extended source unit then for -- sure we want the warning since it definitely belongs - if Parsing_Main_Subunit - or else In_Extended_Main_Source_Unit (Sptr) - then + if In_Extended_Main_Source_Unit (Sptr) then null; -- If the flag location is not in the main extended source unit, then @@ -1159,8 +1157,7 @@ package body Errout is is begin if Eflag - and then (Parsing_Main_Subunit - or else In_Extended_Main_Source_Unit (N)) + and then In_Extended_Main_Source_Unit (N) and then Comes_From_Source (N) then Error_Msg_NEL (Msg, N, N, Sloc (N)); Index: errout.ads =================================================================== --- errout.ads (revision 164176) +++ errout.ads (working copy) @@ -60,21 +60,6 @@ package Errout is -- the use of constructs not permitted by the library in use, or improper -- constructs in No_Run_Time mode). - type Compiler_State_Type is (Parsing, Analyzing); - Compiler_State : Compiler_State_Type; - -- Indicates current state of compilation. This is put in the Errout spec - -- because it affects the handling of error messages. In particular, an - -- attempt is made by Errout to suppress cascaded error messages in Parsing - -- mode, but not in the other modes. - - Parsing_Main_Subunit : Boolean := False; - -- Set True if we are currently parsing a subunit that is part of the main - -- extended source. We need this flag, since the In_Main_Extended_Source - -- test may produce an improper False value if called too early during the - -- parsing process. This is put in the Errout spec because it affects error - -- message handling. In particular, warnings and style messages during - -- parsing are only generated if this flag is set to True. - Current_Error_Source_File : Source_File_Index renames Err_Vars.Current_Error_Source_File; -- Id of current messages. Used to post file name when unit changes. This Index: lib-load.adb =================================================================== --- lib-load.adb (revision 164176) +++ lib-load.adb (working copy) @@ -344,7 +344,8 @@ package body Lib.Load is Subunit : Boolean; Corr_Body : Unit_Number_Type := No_Unit; Renamings : Boolean := False; - With_Node : Node_Id := Empty) return Unit_Number_Type + With_Node : Node_Id := Empty; + PMES : Boolean := False) return Unit_Number_Type is Calling_Unit : Unit_Number_Type; Uname_Actual : Unit_Name_Type; @@ -352,10 +353,11 @@ package body Lib.Load is Unump : Unit_Number_Type; Fname : File_Name_Type; Src_Ind : Source_File_Index; - - -- Start of processing for Load_Unit + Save_PMES : constant Boolean := Parsing_Main_Extended_Source; begin + Parsing_Main_Extended_Source := PMES; + -- If renamings are allowed and we have a child unit name, then we -- must first load the parent to deal with finding the real name. -- Retain the with_clause that names the child, so that if it is @@ -372,6 +374,7 @@ package body Lib.Load is With_Node => With_Node); if Unump = No_Unit then + Parsing_Main_Extended_Source := Save_PMES; return No_Unit; end if; @@ -552,10 +555,12 @@ package body Lib.Load is end if; Write_Dependency_Chain; - return No_Unit; + Unum := No_Unit; + goto Done; else - return No_Unit; + Unum := No_Unit; + goto Done; end if; end if; end loop; @@ -600,7 +605,8 @@ package body Lib.Load is Load_Stack.Decrement_Last; end if; - return No_Unit; + Unum := No_Unit; + goto Done; end if; if Debug_Flag_L then @@ -610,7 +616,7 @@ package body Lib.Load is end if; Load_Stack.Decrement_Last; - return Unum; + goto Done; -- Unit is not already in table, so try to open the file @@ -658,7 +664,7 @@ package body Lib.Load is declare Save_Index : constant Nat := Multiple_Unit_Index; - Save_PMS : constant Boolean := Parsing_Main_Subunit; + Save_PMES : constant Boolean := Parsing_Main_Extended_Source; begin Multiple_Unit_Index := Get_Unit_Index (Uname_Actual); @@ -666,12 +672,12 @@ package body Lib.Load is Initialize_Scanner (Unum, Source_Index (Unum)); if Calling_Unit = Main_Unit and then Subunit then - Parsing_Main_Subunit := True; + Parsing_Main_Extended_Source := True; end if; Discard_List (Par (Configuration_Pragmas => False)); - Parsing_Main_Subunit := Save_PMS; + Parsing_Main_Extended_Source := Save_PMES; Multiple_Unit_Index := Save_Index; Set_Loading (Unum, False); @@ -689,7 +695,8 @@ package body Lib.Load is Error_Msg ("\incorrect spec in file { must be removed first!", Load_Msg_Sloc); - return No_Unit; + Unum := No_Unit; + goto Done; end if; -- If loaded unit had a fatal error, then caller inherits it! @@ -706,7 +713,7 @@ package body Lib.Load is -- All done, return unit number - return Unum; + goto Done; -- Case of file not found @@ -760,9 +767,16 @@ package body Lib.Load is Units.Decrement_Last; end if; - return No_Unit; + Unum := No_Unit; + goto Done; end if; end if; + + -- Here to exit, with result in Unum + + <> + Parsing_Main_Extended_Source := Save_PMES; + return Unum; end Load_Unit; -------------------------- Index: lib-load.ads =================================================================== --- lib-load.ads (revision 164167) +++ lib-load.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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- -- @@ -109,7 +109,8 @@ package Lib.Load is Subunit : Boolean; Corr_Body : Unit_Number_Type := No_Unit; Renamings : Boolean := False; - With_Node : Node_Id := Empty) return Unit_Number_Type; + With_Node : Node_Id := Empty; + PMES : Boolean := False) return Unit_Number_Type; -- This function loads and parses the unit specified by Load_Name (or -- returns the unit number for the previously constructed units table -- entry if this is not the first call for this unit). Required indicates @@ -151,6 +152,9 @@ package Lib.Load is -- With_Node is set to the with_clause or limited_with_clause causing -- the unit to be loaded, and is used to bypass the circular dependency -- check in the case of a limited_with_clause (Ada 2005, AI-50217). + -- + -- PMES indicates the required setting of Parsing_Main_Extended_Unit during + -- loading of the unit. This flag is saved and restored over the call. procedure Change_Main_Unit_To_Spec; -- This procedure is called if the main unit file contains a No_Body pragma