prj-proc.adb, [...] (Load_Naming_Exceptions): New subprogram.

2009-04-22  Emmanuel Briot  <briot@adacore.com>

	* prj-proc.adb, prj-nmsc.adb (Load_Naming_Exceptions): New subprogram.
	Minor refactoring to reduce the size of
	Process_Sources_In_Multi_Language_Mode.
	Avoid extra copied of Source_Data, which we found in the past could be
	quite slow.
	(Mark_Excluded_Sources): new subprogram.
	(Remove_Locally_Removed_Files_From_Units): merged into the above
 	Refactors Process_Sources_In_Multi_Language_Mode to reduce its size,
 	and allow better sharing of code between multi_lang and ada_only modes
	(Project_Extends): removed, since exact duplicate of Prj.Is_Extending

From-SVN: r146565

3 files changed, 185 insertions, 188 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index faf2e23..79a7fa4 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,18 @@
 2009-04-22  Emmanuel Briot  <briot@adacore.com>
 
+	* prj-proc.adb, prj-nmsc.adb (Load_Naming_Exceptions): New subprogram.
+	Minor refactoring to reduce the size of
+	Process_Sources_In_Multi_Language_Mode.
+	Avoid extra copied of Source_Data, which we found in the past could be
+	quite slow.
+	(Mark_Excluded_Sources): new subprogram.
+	(Remove_Locally_Removed_Files_From_Units): merged into the above
+ 	Refactors Process_Sources_In_Multi_Language_Mode to reduce its size,
+ 	and allow better sharing of code between multi_lang and ada_only modes
+	(Project_Extends): removed, since exact duplicate of Prj.Is_Extending
+
+2009-04-22  Emmanuel Briot  <briot@adacore.com>
+
 	* prj-proc.adb, prj.adb, prj.ads (Project_Data.First_Referred_By):
 	Removed, since unused.
 
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index f0058c2..31e5bdf 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -101,6 +101,8 @@ package body Prj.Nmsc is
       Spec : File_Name_Type;
       Impl : File_Name_Type;
    end record;
+   --  Record special naming schemes for Ada units (name of spec file and name
+   --  of implementation file).
 
    No_Unit_Exception : constant Unit_Exception :=
                          (Name => No_Name,
@@ -213,6 +215,14 @@ package body Prj.Nmsc is
    --  A table to check if a unit with an exceptional name will hide a source
    --  with a file name following the naming convention.
 
+   procedure Load_Naming_Exceptions
+     (Project     : Project_Id;
+      In_Tree     : Project_Tree_Ref;
+      Data        : in out Project_Data);
+   --  All source files in Data.First_Source are considered as naming
+   --  exceptions, and copied into the Source_Names and Unit_Exceptions tables
+   --  as appropriate.
+
    procedure Add_Source
      (Id                  : out Source_Id;
       Data                : in out Project_Data;
@@ -499,7 +509,8 @@ package body Prj.Nmsc is
       Data        : in out Project_Data;
       Current_Dir : String);
    --  Find all the sources of project Project in project tree In_Tree and
-   --  update its Data accordingly.
+   --  update its Data accordingly. This assumes that Data.First_Source has
+   --  been initialized with the list of excluded sources.
    --
    --  Current_Dir should represent the current directory, and is passed for
    --  efficiency to avoid system calls to recompute it.
@@ -517,13 +528,6 @@ package body Prj.Nmsc is
    --  Prepare the internal hash tables used for checking naming exceptions
    --  for Ada. Insert all elements of List in the tables.
 
-   function Project_Extends
-     (Extending : Project_Id;
-      Extended  : Project_Id;
-      In_Tree   : Project_Tree_Ref) return Boolean;
-   --  Returns True if Extending is extending Extended either directly or
-   --  indirectly.
-
    procedure Record_Ada_Source
      (File_Name       : File_Name_Type;
       Path_Name       : Path_Name_Type;
@@ -8602,198 +8606,198 @@ package body Prj.Nmsc is
       end if;
    end Search_Directories;
 
-   ----------------------
-   -- Look_For_Sources --
-   ----------------------
+   ----------------------------
+   -- Load_Naming_Exceptions --
+   ----------------------------
 
-   procedure Look_For_Sources
+   procedure Load_Naming_Exceptions
      (Project     : Project_Id;
       In_Tree     : Project_Tree_Ref;
-      Data        : in out Project_Data;
-      Current_Dir : String)
+      Data        : in out Project_Data)
    is
-      procedure Remove_Locally_Removed_Files_From_Units;
-      --  Mark all locally removed sources as such in the Units table
+      Source   : Source_Id := Data.First_Source;
+      File     : File_Name_Type;
+      Unit     : Name_Id;
+   begin
+      Unit_Exceptions.Reset;
 
-      procedure Process_Sources_In_Multi_Language_Mode;
-      --  Find all source files when in multi language mode
+      while Source /= No_Source loop
+         File := In_Tree.Sources.Table (Source).File;
+         Unit := In_Tree.Sources.Table (Source).Unit;
 
-      ---------------------------------------------
-      -- Remove_Locally_Removed_Files_From_Units --
-      ---------------------------------------------
+         --  An excluded file cannot also be an exception file name
 
-      procedure Remove_Locally_Removed_Files_From_Units is
-         Excluded : File_Found;
-         OK       : Boolean;
-         Unit     : Unit_Data;
-         Extended : Project_Id;
-
-      begin
-         Excluded := Excluded_Sources_Htable.Get_First;
-         while Excluded /= No_File_Found loop
-            OK := False;
+         if Excluded_Sources_Htable.Get (File) /= No_File_Found then
+            Error_Msg_File_1 := File;
+            Error_Msg
+              (Project, In_Tree,
+               "{ cannot be both excluded and an exception file name",
+               No_Location);
+         end if;
 
-            For_Each_Unit :
-            for Index in Unit_Table.First ..
-              Unit_Table.Last (In_Tree.Units)
-            loop
-               Unit := In_Tree.Units.Table (Index);
+         if Current_Verbosity = High then
+            Write_Str ("Naming exception: Putting source #");
+            Write_Str (Source'Img);
+            Write_Str (", file ");
+            Write_Str (Get_Name_String (File));
+            Write_Line (" in Source_Names");
+         end if;
 
-               for Kind in Spec_Or_Body'Range loop
-                  if Unit.File_Names (Kind).Name = Excluded.File then
-                     OK := True;
+         Source_Names.Set
+           (K => File,
+            E => Name_Location'
+              (Name     => File,
+               Location => No_Location,
+               Source   => Source,
+               Except   => Unit /= No_Name,
+               Found    => False));
 
-                     --  Check that this is from the current project or
-                     --  that the current project extends.
+         --  If this is an Ada exception, record in table Unit_Exceptions
 
-                     Extended := Unit.File_Names (Kind).Project;
+         if Unit /= No_Name then
+            declare
+               Unit_Except : Unit_Exception := Unit_Exceptions.Get (Unit);
 
-                     if Extended = Project
-                       or else Project_Extends (Project, Extended, In_Tree)
-                     then
-                        Unit.File_Names (Kind).Path.Name := Slash;
-                        Unit.File_Names (Kind).Needs_Pragma := False;
-                        In_Tree.Units.Table (Index) := Unit;
-                        Add_Forbidden_File_Name
-                          (Unit.File_Names (Kind).Name);
-                     else
-                        Error_Msg
-                          (Project, In_Tree,
-                           "cannot remove a source from " &
-                           "another project",
-                           Excluded.Location);
-                     end if;
-                     exit For_Each_Unit;
-                  end if;
-               end loop;
-            end loop For_Each_Unit;
+            begin
+               Unit_Except.Name := Unit;
 
-            if not OK then
-               Err_Vars.Error_Msg_File_1 := Excluded.File;
-               Error_Msg
-                 (Project, In_Tree, "unknown file {", Excluded.Location);
-            end if;
+               if In_Tree.Sources.Table (Source).Kind = Spec then
+                  Unit_Except.Spec := File;
+               else
+                  Unit_Except.Impl := File;
+               end if;
 
-            Excluded := Excluded_Sources_Htable.Get_Next;
-         end loop;
-      end Remove_Locally_Removed_Files_From_Units;
+               Unit_Exceptions.Set (Unit, Unit_Except);
+            end;
+         end if;
 
-      --------------------------------------------
-      -- Process_Sources_In_Multi_Language_Mode --
-      --------------------------------------------
+         Source := In_Tree.Sources.Table (Source).Next_In_Project;
+      end loop;
+   end Load_Naming_Exceptions;
 
-      procedure Process_Sources_In_Multi_Language_Mode is
-         Source   : Source_Id;
-         Name_Loc : Name_Location;
-         OK       : Boolean;
-         FF       : File_Found;
+   ----------------------
+   -- Look_For_Sources --
+   ----------------------
 
-      begin
-         --  First, put all naming exceptions if any, in the Source_Names table
+   procedure Look_For_Sources
+     (Project     : Project_Id;
+      In_Tree     : Project_Tree_Ref;
+      Data        : in out Project_Data;
+      Current_Dir : String)
+   is
+      procedure Process_Sources_In_Multi_Language_Mode;
+      --  Find all source files when in multi language mode
 
-         Unit_Exceptions.Reset;
+      procedure Mark_Excluded_Sources;
+      --  Mark as such the sources that are declared as excluded
 
-         Source := Data.First_Source;
-         while Source /= No_Source loop
-            declare
-               Src_Data : Source_Data renames In_Tree.Sources.Table (Source);
+      ---------------------------
+      -- Mark_Excluded_Sources --
+      ---------------------------
 
-            begin
-               --  An excluded file cannot also be an exception file name
+      procedure Mark_Excluded_Sources is
+         Source   : Source_Id := No_Source;
+         OK       : Boolean;
+         Unit     : Unit_Data;
+         Excluded : File_Found := Excluded_Sources_Htable.Get_First;
 
-               if Excluded_Sources_Htable.Get (Src_Data.File) /=
-                 No_File_Found
-               then
-                  Error_Msg_File_1 := Src_Data.File;
-                  Error_Msg
-                    (Project, In_Tree,
-                     "{ cannot be both excluded and an exception file name",
-                     No_Location);
-               end if;
+         procedure Exclude
+           (Extended : Project_Id; Index : Unit_Index; Kind : Spec_Or_Body);
+         --  If the current file (Excluded) belongs to the current project or
+         --  one that the current project extends, then mark this file/unit as
+         --  excluded. It is an error to locally remove a file from another
+         --  project.
 
-               Name_Loc := (Name     => Src_Data.File,
-                            Location => No_Location,
-                            Source   => Source,
-                            Except   => Src_Data.Unit /= No_Name,
-                            Found    => False);
+         procedure Exclude
+           (Extended : Project_Id; Index : Unit_Index; Kind : Spec_Or_Body) is
+         begin
+            if Extended = Project
+              or else Is_Extending (Project, Extended, In_Tree)
+            then
+               OK := True;
 
-               if Current_Verbosity = High then
-                  Write_Str ("Putting source #");
-                  Write_Str (Source'Img);
-                  Write_Str (", file ");
-                  Write_Str (Get_Name_String (Src_Data.File));
-                  Write_Line (" in Source_Names");
+               if Index /= No_Unit_Index then
+                  Unit.File_Names (Kind).Path.Name    := Slash;
+                  Unit.File_Names (Kind).Needs_Pragma := False;
+                  In_Tree.Units.Table (Index) := Unit;
                end if;
 
-               Source_Names.Set (K => Src_Data.File, E => Name_Loc);
-
-               --  If this is an Ada exception, record in table Unit_Exceptions
-
-               if Src_Data.Unit /= No_Name then
-                  declare
-                     Unit_Except : Unit_Exception :=
-                                     Unit_Exceptions.Get (Src_Data.Unit);
-
-                  begin
-                     Unit_Except.Name := Src_Data.Unit;
-
-                     if Src_Data.Kind = Spec then
-                        Unit_Except.Spec := Src_Data.File;
-                     else
-                        Unit_Except.Impl := Src_Data.File;
-                     end if;
-
-                     Unit_Exceptions.Set (Src_Data.Unit, Unit_Except);
-                  end;
+               if Source /= No_Source then
+                  In_Tree.Sources.Table (Source).Locally_Removed := True;
+                  In_Tree.Sources.Table (Source).In_Interfaces := False;
                end if;
 
-               Source := Src_Data.Next_In_Project;
-            end;
-         end loop;
+               if Current_Verbosity = High then
+                  Write_Str ("Removing file ");
+                  Write_Line (Get_Name_String (Excluded.File));
+               end if;
 
-         Find_Explicit_Sources
-           (Current_Dir, Project, In_Tree, Data);
+               Add_Forbidden_File_Name (Excluded.File);
 
-         --  Mark as such the sources that are declared as excluded
+            else
+               Error_Msg
+                 (Project, In_Tree,
+                  "cannot remove a source from another project",
+                  Excluded.Location);
+            end if;
+         end Exclude;
 
-         FF := Excluded_Sources_Htable.Get_First;
-         while FF /= No_File_Found loop
+      begin
+         while Excluded /= No_File_Found loop
             OK     := False;
-            Source := In_Tree.First_Source;
-            while Source /= No_Source loop
-               declare
-                  Src_Data : Source_Data renames
-                               In_Tree.Sources.Table (Source);
 
-               begin
-                  if Src_Data.File = FF.File then
-
-                     --  Check that this is from this project or a project that
-                     --  the current project extends.
+            case Get_Mode is
+            when Ada_Only =>
+               --  ??? This loop could be the same as for Multi_Language if
+               --  we were setting In_Tree.First_Source when we search for
+               --  Ada sources (basically once we have removed the use of
+               --  Data.Ada_Sources).
+               For_Each_Unit :
+               for Index in Unit_Table.First ..
+                 Unit_Table.Last (In_Tree.Units)
+               loop
+                  Unit := In_Tree.Units.Table (Index);
 
-                     if Src_Data.Project = Project or else
-                       Is_Extending (Project, Src_Data.Project, In_Tree)
-                     then
-                        Src_Data.Locally_Removed := True;
-                        Src_Data.In_Interfaces := False;
-                        Add_Forbidden_File_Name (FF.File);
-                        OK := True;
-                        exit;
+                  for Kind in Spec_Or_Body'Range loop
+                     if Unit.File_Names (Kind).Name = Excluded.File then
+                        Exclude (Unit.File_Names (Kind).Project, Index, Kind);
+                        exit For_Each_Unit;
                      end if;
+                  end loop;
+               end loop For_Each_Unit;
+
+            when Multi_Language =>
+               Source := In_Tree.First_Source;
+               while Source /= No_Source loop
+                  if In_Tree.Sources.Table (Source).File = Excluded.File then
+                     Exclude
+                       (In_Tree.Sources.Table (Source).Project,
+                        No_Unit_Index, Specification);
+                     exit;
                   end if;
 
-                  Source := Src_Data.Next_In_Sources;
-               end;
-            end loop;
+                  Source := In_Tree.Sources.Table (Source).Next_In_Sources;
+               end loop;
+
+               OK := OK or Excluded.Found;
+            end case;
 
-            if not FF.Found and not OK then
-               Err_Vars.Error_Msg_File_1 := FF.File;
-               Error_Msg (Project, In_Tree, "unknown file {", FF.Location);
+            if not OK then
+               Err_Vars.Error_Msg_File_1 := Excluded.File;
+               Error_Msg
+                 (Project, In_Tree, "unknown file {", Excluded.Location);
             end if;
 
-            FF := Excluded_Sources_Htable.Get_Next;
+            Excluded := Excluded_Sources_Htable.Get_Next;
          end loop;
+      end Mark_Excluded_Sources;
+
+      --------------------------------------------
+      -- Process_Sources_In_Multi_Language_Mode --
+      --------------------------------------------
 
+      procedure Process_Sources_In_Multi_Language_Mode is
+      begin
          --  Check that two sources of this project do not have the same object
          --  file name.
 
@@ -8840,8 +8844,7 @@ package body Prj.Nmsc is
 
                begin
                   if Src_Data.Compiled and then Src_Data.Object_Exists
-                    and then Project_Extends
-                               (Project, Src_Data.Project, In_Tree)
+                    and then Is_Extending (Project, Src_Data.Project, In_Tree)
                   then
                      if Src_Data.Unit = No_Name then
                         if Src_Data.Kind = Impl then
@@ -8901,11 +8904,14 @@ package body Prj.Nmsc is
          when Ada_Only =>
             if Is_A_Language (In_Tree, Data, Name_Ada) then
                Find_Explicit_Sources (Current_Dir, Project, In_Tree, Data);
-               Remove_Locally_Removed_Files_From_Units;
+               Mark_Excluded_Sources;
             end if;
 
          when Multi_Language =>
             if Data.First_Language_Processing /= No_Language_Index then
+               Load_Naming_Exceptions (Project, In_Tree, Data);
+               Find_Explicit_Sources (Current_Dir, Project, In_Tree, Data);
+               Mark_Excluded_Sources;
                Process_Sources_In_Multi_Language_Mode;
             end if;
       end case;
@@ -8983,30 +8989,6 @@ package body Prj.Nmsc is
       end loop;
    end Prepare_Ada_Naming_Exceptions;
 
-   ---------------------
-   -- Project_Extends --
-   ---------------------
-
-   function Project_Extends
-     (Extending : Project_Id;
-      Extended  : Project_Id;
-      In_Tree   : Project_Tree_Ref) return Boolean
-   is
-      Current : Project_Id := Extending;
-
-   begin
-      loop
-         if Current = No_Project then
-            return False;
-
-         elsif Current = Extended then
-            return True;
-         end if;
-
-         Current := In_Tree.Projects.Table (Current).Extends;
-      end loop;
-   end Project_Extends;
-
    -----------------------
    -- Record_Ada_Source --
    -----------------------
@@ -9173,7 +9155,7 @@ package body Prj.Nmsc is
                         The_Unit_Data.File_Names
                           (Unit_Kind).Path.Name = Slash)
                     or else The_Unit_Data.File_Names (Unit_Kind).Name = No_File
-                    or else Project_Extends
+                    or else Is_Extending
                       (Data.Extends,
                        The_Unit_Data.File_Names (Unit_Kind).Project,
                        In_Tree)
diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb
index 47a81a8..933df7f 100644
--- a/gcc/ada/prj-proc.adb
+++ b/gcc/ada/prj-proc.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2001-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-2009, 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- --
@@ -2632,6 +2632,7 @@ package body Prj.Proc is
                declare
                   New_Project : Project_Id;
                   New_Data    : Project_Data;
+                  pragma Unreferenced (New_Data);
                   Proj_Node   : Project_Node_Id;
 
                begin
@@ -2834,6 +2835,7 @@ package body Prj.Proc is
                declare
                   New_Project : Project_Id;
                   New_Data    : Project_Data;
+                  pragma Unreferenced (New_Data);
                   Proj_Node   : Project_Node_Id;
 
                begin