===================================================================
@@ -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");
===================================================================
@@ -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.
===================================================================
@@ -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- --
@@ -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
===================================================================
@@ -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));
===================================================================
@@ -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;
===================================================================
@@ -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- --
@@ -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;
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 <dewar@adacore.com> * 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