===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- 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
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- 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 --
--------------------------------------------
===================================================================
@@ -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.
===================================================================
@@ -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
===================================================================
@@ -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));
===================================================================
@@ -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
===================================================================
@@ -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
+
+ <<Done>>
+ Parsing_Main_Extended_Source := Save_PMES;
+ return Unum;
end Load_Unit;
--------------------------
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- 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
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 <dewar@adacore.com> * 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