From patchwork Fri Sep 10 13:54:02 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Subject: [Ada] Do style checks for main subunits From: Arnaud Charlet X-Patchwork-Id: 64393 Message-Id: <20100910135402.GA18811@adacore.com> To: gcc-patches@gcc.gnu.org Cc: Robert Dewar Date: Fri, 10 Sep 2010 15:54:02 +0200 Previously if a unit was compiled with style checks, and subunits of this unit had style errors, they were not always diagnosed during the compilation of the main unit. This patch ensures that all subunits are fully checked for style errors. For the following test: package Pkg is procedure Execute (X : Natural := 0); end Pkg; package body Pkg is procedure Execute (X : Natural := 0) is separate; procedure Execute2 (X : Natural := 0) is begin if (X = 0) then null; end if; end Execute2; end Pkg; separate (Pkg) procedure Execute (X : Natural := 0) is begin if (X = 0) then null; end if; end Execute; Compilation of pkg.adb with -gnatyx yields: pkg.adb:5:10: warning: redundant parentheses pkg-execute.adb:4:07: warning: redundant parentheses Prior to this patch, the second message was omitted Tested on x86_64-pc-linux-gnu, committed on trunk 2010-09-10 Robert Dewar * errout.adb (Error_Msg_Internal): Test Parsing_Main_Subunit flag (Error_Msg_NW): Test Parsing_Main_Subunit flag * errout.ads (Parsing_Main_Subunit): New flag * lib-load.adb (Load_Unit): Set Parsing_Main_Subunit flag * par-ch6.adb: Minor style fix (remove redandant parentheses) * par-ch9.adb: Minor style fix (remove redundant parens) * par-load.adb: (Load): Deal with setting Parsing_Main_Subunit Index: par-ch9.adb =================================================================== --- par-ch9.adb (revision 164167) +++ par-ch9.adb (working copy) @@ -639,7 +639,7 @@ package body Ch9 is Is_Overriding := True; end if; - if (Is_Overriding or else Not_Overriding) then + if Is_Overriding or else Not_Overriding then if Ada_Version < Ada_05 then Error_Msg_SP ("overriding indicator is an Ada 2005 extension"); Error_Msg_SP ("\unit must be compiled with -gnat05 switch"); @@ -823,7 +823,7 @@ package body Ch9 is Is_Overriding := True; end if; - if (Is_Overriding or else Not_Overriding) then + if Is_Overriding or else Not_Overriding then if Ada_Version < Ada_05 then Error_Msg_SP ("overriding indicator is an Ada 2005 extension"); Error_Msg_SP ("\unit must be compiled with -gnat05 switch"); Index: par-ch6.adb =================================================================== --- par-ch6.adb (revision 164167) +++ par-ch6.adb (working copy) @@ -211,7 +211,7 @@ package body Ch6 is Is_Overriding := True; end if; - if (Is_Overriding or else Not_Overriding) then + if Is_Overriding or else Not_Overriding then -- Note that if we are not in Ada_05 mode, error messages have -- already been given, so no need to give another message here. Index: par-load.adb =================================================================== --- par-load.adb (revision 164167) +++ par-load.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- -- @@ -268,9 +268,9 @@ begin Error_Node => Curunit, Corr_Body => Cur_Unum); - -- 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 have set our Fatal_Error flag to propagate this condition. + -- 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 + -- have set our Fatal_Error flag to propagate this condition. if Unum /= No_Unit then Set_Library_Unit (Curunit, Cunit (Unum)); @@ -342,17 +342,25 @@ begin -- If current unit is a subunit, then load its parent body elsif Nkind (Unit (Curunit)) = N_Subunit then - Body_Name := Get_Parent_Body_Name (Unit_Name (Cur_Unum)); - Unum := - Load_Unit - (Load_Name => Body_Name, - Required => True, - Subunit => True, - Error_Node => Name (Unit (Curunit))); + declare + Save_PMS : constant Boolean := Parsing_Main_Subunit; - if Unum /= No_Unit then - Set_Library_Unit (Curunit, Cunit (Unum)); - end if; + 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; + + Parsing_Main_Subunit := Save_PMS; + end; end if; -- Now we load with'ed units, with style/validity checks turned off Index: errout.adb =================================================================== --- errout.adb (revision 164167) +++ errout.adb (working copy) @@ -748,7 +748,9 @@ 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 In_Extended_Main_Source_Unit (Sptr) then + if Parsing_Main_Subunit + or else In_Extended_Main_Source_Unit (Sptr) + then null; -- If the flag location is not in the main extended source unit, then @@ -1157,7 +1159,8 @@ package body Errout is is begin if Eflag - and then In_Extended_Main_Source_Unit (N) + and then (Parsing_Main_Subunit + or else 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 164167) +++ errout.ads (working copy) @@ -63,9 +63,17 @@ package Errout is 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 action of the error message handling. In - -- particular, an attempt is made by Errout to suppress cascaded error - -- messages in Parsing mode, but not in the other modes. + -- 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; Index: lib-load.adb =================================================================== --- lib-load.adb (revision 164167) +++ lib-load.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- -- @@ -513,7 +513,6 @@ package body Lib.Load is -- See if we already have an entry for this unit Unum := Main_Unit; - while Unum <= Units.Last loop exit when Uname_Actual = Units.Table (Unum).Unit_Name; Unum := Unum + 1; @@ -658,12 +657,22 @@ package body Lib.Load is -- Parse the new unit declare - Save_Index : constant Nat := Multiple_Unit_Index; + Save_Index : constant Nat := Multiple_Unit_Index; + Save_PMS : constant Boolean := Parsing_Main_Subunit; + begin Multiple_Unit_Index := Get_Unit_Index (Uname_Actual); Units.Table (Unum).Munit_Index := Multiple_Unit_Index; Initialize_Scanner (Unum, Source_Index (Unum)); + + if Calling_Unit = Main_Unit and then Subunit then + Parsing_Main_Subunit := True; + end if; + Discard_List (Par (Configuration_Pragmas => False)); + + Parsing_Main_Subunit := Save_PMS; + Multiple_Unit_Index := Save_Index; Set_Loading (Unum, False); end;