Patchwork [Ada] Do style checks for main subunits

login
register
mail settings
Submitter Arnaud Charlet
Date Sept. 10, 2010, 1:54 p.m.
Message ID <20100910135402.GA18811@adacore.com>
Download mbox | patch
Permalink /patch/64393/
State New
Headers show

Comments

Arnaud Charlet - Sept. 10, 2010, 1:54 p.m.
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

Patch

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;