make.adb, [...] (Create_Mapping_File): merge the two versions for Ada_Only and Multi_...

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

	* make.adb, prj-env.adb, prj-env.ads, prj-nmsc.adb, prj.adb,
	prj.ads (Create_Mapping_File): merge the two versions for Ada_Only and
	Multi_Language modes, to avoid code duplication.
	(Project_Data.Include_Language): Removed.

From-SVN: r146586

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a1b8ad128ed0ecdde015deb706bd69ef57da8e90..235cf5386c6338b9f7bbb0d3dd73b0422e7fcbd9 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2009-04-22  Emmanuel Briot  <briot@adacore.com>
+
+       * make.adb, prj-env.adb, prj-env.ads, prj-nmsc.adb, prj.adb,
+       prj.ads (Create_Mapping_File): merge the two versions for Ada_Only and
+       Multi_Language modes, to avoid code duplication.
+       (Project_Data.Include_Language): Removed.
+
 2009-04-22  Vincent Celier  <celier@adacore.com>
 
        * tempdir.adb (Create_Temp_File): Add a diagnostic in verbose mode when

diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb
index 559baeb0d46be3bcf716db5dd5402df2b8ab5856..168e4f3643d46ca4d670fc2e780744d776103e30 100644 (file)
--- a/gcc/ada/make.adb
+++ b/gcc/ada/make.adb
@@ -6380,7 +6380,7 @@ package body Make is
                                     Library_Paths.Table (Index).all);
                               end loop;
 
-                              --  One switch for the standard GNAT library dir.
+                              --  One switch for the standard GNAT library dir
 
                               Linker_Switches.Increment_Last;
                               Linker_Switches.Table
@@ -6809,9 +6809,11 @@ package body Make is
 
       if Project /= No_Project then
          Prj.Env.Create_Mapping_File
-           (Project, Project_Tree,
-            The_Mapping_File_Names
-              (Project, Last_Mapping_File_Names (Project)));
+           (Project,
+            In_Tree  => Project_Tree,
+            Language => No_Name,
+            Name     => The_Mapping_File_Names
+                          (Project, Last_Mapping_File_Names (Project)));
 
       --  Otherwise, just create an empty file
 

diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb
index 3be45314142981adcf1043f68e9a1bd0b3f66d24..3b0b1e51e00735fb8bf2cfa58e918ed340358575 100644 (file)
--- a/gcc/ada/prj-env.adb
+++ b/gcc/ada/prj-env.adb
@@ -57,14 +57,9 @@ package body Prj.Env is
    --  platforms, except on VMS where the logical names are deassigned, thus
    --  avoiding the pollution of the environment of the caller.
 
-   Default_Naming : constant Naming_Id := Naming_Table.First;
-
+   Default_Naming    : constant Naming_Id := Naming_Table.First;
    Fill_Mapping_File : Boolean := True;
 
-   type Project_Flags is array (Project_Id range <>) of Boolean;
-   --  A Boolean array type used in Create_Mapping_File to select the projects
-   --  in the closure of a specific project.
-
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -1041,22 +1036,24 @@ package body Prj.Env is
    -------------------------
 
    procedure Create_Mapping_File
-     (Project : Project_Id;
-      In_Tree : Project_Tree_Ref;
-      Name    : out Path_Name_Type)
+     (Project  : Project_Id;
+      Language : Name_Id := No_Name;
+      In_Tree  : Project_Tree_Ref;
+      Name     : out Path_Name_Type)
    is
-      File          : File_Descriptor := Invalid_FD;
-      The_Unit_Data : Unit_Data;
-      Data          : File_Name_Data;
-
+      File   : File_Descriptor := Invalid_FD;
       Status : Boolean;
-      --  For call to Close
 
-      Present       : Project_Flags
-        (No_Project .. Project_Table.Last (In_Tree.Projects)) :=
-        (others => False);
+      Present : array (No_Project .. Project_Table.Last (In_Tree.Projects))
+                  of Boolean := (others => False);
       --  For each project in the closure of Project, the corresponding flag
-      --  will be set to True;
+      --  will be set to True.
+
+      Source        : Source_Id;
+      Src_Data      : Source_Data;
+      Suffix        : File_Name_Type;
+      The_Unit_Data : Unit_Data;
+      Data          : File_Name_Data;
 
       procedure Put_Name_Buffer;
       --  Put the line contained in the Name_Buffer in the mapping file
@@ -1082,7 +1079,7 @@ package body Prj.Env is
          Last := Write (File, Name_Buffer (1)'Address, Name_Len);
 
          if Last /= Name_Len then
-            Prj.Com.Fail ("Disk full");
+            Prj.Com.Fail ("Disk full, cannot write mapping file");
          end if;
       end Put_Name_Buffer;
 
@@ -1116,7 +1113,6 @@ package body Prj.Env is
 
          Get_Name_String (Data.Path.Name);
          Put_Name_Buffer;
-
       end Put_Data;
 
       --------------------
@@ -1128,32 +1124,21 @@ package body Prj.Env is
          Proj     : Project_Id;
 
       begin
-         --  Nothing to do for non existent project or project that has
-         --  already been flagged.
-
-         if Prj = No_Project or else Present (Prj) then
-            return;
-         end if;
-
-         --  Flag the current project
-
-         Present (Prj) := True;
-         Imported :=
-           In_Tree.Projects.Table (Prj).Imported_Projects;
-
-         --  Call itself for each project directly imported
+         --  Nothing to do for non existent project or project that has already
+         --  been flagged.
 
-         while Imported /= Empty_Project_List loop
-            Proj :=
-              In_Tree.Project_Lists.Table (Imported).Project;
-            Imported :=
-              In_Tree.Project_Lists.Table (Imported).Next;
-            Recursive_Flag (Proj);
-         end loop;
+         if Prj /= No_Project and then not Present (Prj) then
+            Present (Prj) := True;
 
-         --  Call itself for an eventual project being extended
+            Imported := In_Tree.Projects.Table (Prj).Imported_Projects;
+            while Imported /= Empty_Project_List loop
+               Proj     := In_Tree.Project_Lists.Table (Imported).Project;
+               Imported := In_Tree.Project_Lists.Table (Imported).Next;
+               Recursive_Flag (Proj);
+            end loop;
 
-         Recursive_Flag (In_Tree.Projects.Table (Prj).Extends);
+            Recursive_Flag (In_Tree.Projects.Table (Prj).Extends);
+         end if;
       end Recursive_Flag;
 
    --  Start of processing for Create_Mapping_File
@@ -1180,201 +1165,90 @@ package body Prj.Env is
          end if;
       end if;
 
-      if Fill_Mapping_File then
+      if Language = No_Name then
+         if Fill_Mapping_File then
+            for Unit in 1 .. Unit_Table.Last (In_Tree.Units) loop
+               The_Unit_Data := In_Tree.Units.Table (Unit);
 
-         --  For all units in table Units
+               --  Case of unit has a valid name
 
-         for Unit in 1 .. Unit_Table.Last (In_Tree.Units) loop
-            The_Unit_Data := In_Tree.Units.Table (Unit);
+               if The_Unit_Data.Name /= No_Name then
+                  Data := The_Unit_Data.File_Names (Specification);
 
-            --  If the unit has a valid name
+                  --  If there is a spec, put it mapping in the file if it is
+                  --  from a project in the closure of Project.
 
-            if The_Unit_Data.Name /= No_Name then
-               Data := The_Unit_Data.File_Names (Specification);
-
-               --  If there is a spec, put it mapping in the file if it is
-               --  from a project in the closure of Project.
-
-               if Data.Name /= No_File and then Present (Data.Project) then
-                  Put_Data (Spec => True);
-               end if;
+                  if Data.Name /= No_File and then Present (Data.Project) then
+                     Put_Data (Spec => True);
+                  end if;
 
-               Data := The_Unit_Data.File_Names (Body_Part);
+                  Data := The_Unit_Data.File_Names (Body_Part);
 
-               --  If there is a body (or subunit) put its mapping in the file
-               --  if it is from a project in the closure of Project.
+                  --  If there is a body (or subunit) put its mapping in the
+                  --  file if it is from a project in the closure of Project.
 
-               if Data.Name /= No_File and then Present (Data.Project) then
-                  Put_Data (Spec => False);
+                  if Data.Name /= No_File and then Present (Data.Project) then
+                     Put_Data (Spec => False);
+                  end if;
                end if;
-
-            end if;
-         end loop;
-      end if;
-
-      GNAT.OS_Lib.Close (File, Status);
-
-      if not Status then
-         Prj.Com.Fail ("disk full");
-      end if;
-   end Create_Mapping_File;
-
-   procedure Create_Mapping_File
-     (Project  : Project_Id;
-      Language : Name_Id;
-      In_Tree  : Project_Tree_Ref;
-      Name     : out Path_Name_Type)
-   is
-      File : File_Descriptor := Invalid_FD;
-
-      Status : Boolean;
-      --  For call to Close
-
-      Present : Project_Flags
-                 (No_Project .. Project_Table.Last (In_Tree.Projects)) :=
-                   (others => False);
-      --  For each project in the closure of Project, the corresponding flag
-      --  will be set to True.
-
-      Source   : Source_Id;
-      Src_Data : Source_Data;
-      Suffix   : File_Name_Type;
-
-      procedure Put_Name_Buffer;
-      --  Put the line contained in the Name_Buffer in the mapping file
-
-      procedure Recursive_Flag (Prj : Project_Id);
-      --  Set the flags corresponding to Prj, the projects it imports
-      --  (directly or indirectly) or extends to True. Call itself recursively.
-
-      ---------
-      -- Put --
-      ---------
-
-      procedure Put_Name_Buffer is
-         Last : Natural;
-
-      begin
-         Name_Len := Name_Len + 1;
-         Name_Buffer (Name_Len) := ASCII.LF;
-         Last := Write (File, Name_Buffer (1)'Address, Name_Len);
-
-         if Last /= Name_Len then
-            Prj.Com.Fail ("Disk full");
-         end if;
-      end Put_Name_Buffer;
-
-      --------------------
-      -- Recursive_Flag --
-      --------------------
-
-      procedure Recursive_Flag (Prj : Project_Id) is
-         Imported : Project_List;
-         Proj     : Project_Id;
-
-      begin
-         --  Nothing to do for non existent project or project that has already
-         --  been flagged.
-
-         if Prj = No_Project or else Present (Prj) then
-            return;
+            end loop;
          end if;
 
-         --  Flag the current project
-
-         Present (Prj) := True;
-         Imported :=
-           In_Tree.Projects.Table (Prj).Imported_Projects;
-
-         --  Call itself for each project directly imported
-
-         while Imported /= Empty_Project_List loop
-            Proj :=
-              In_Tree.Project_Lists.Table (Imported).Project;
-            Imported :=
-              In_Tree.Project_Lists.Table (Imported).Next;
-            Recursive_Flag (Proj);
-         end loop;
-
-         --  Call itself for an eventual project being extended
-
-         Recursive_Flag (In_Tree.Projects.Table (Prj).Extends);
-      end Recursive_Flag;
-
-   --  Start of processing for Create_Mapping_File
-
-   begin
-      --  Flag the necessary projects
-
-      Recursive_Flag (Project);
-
-      --  Create the temporary file
-
-      Tempdir.Create_Temp_File (File, Name => Name);
-
-      if File = Invalid_FD then
-         Prj.Com.Fail ("unable to create temporary mapping file");
-
+      --  If language is defined
       else
-         Record_Temp_File (Name);
-
-         if Opt.Verbose_Mode then
-            Write_Str ("Creating temp mapping file """);
-            Write_Str (Get_Name_String (Name));
-            Write_Line ("""");
-         end if;
-      end if;
-
-      --  For all source of the Language of all projects in the closure
+         --  For all source of the Language of all projects in the closure
+
+         for Proj in Present'Range loop
+            if Present (Proj) then
+               Source := In_Tree.Projects.Table (Proj).First_Source;
+               while Source /= No_Source loop
+                  Src_Data := In_Tree.Sources.Table (Source);
+
+                  if In_Tree.Languages_Data.Table
+                    (In_Tree.Sources.Table (Source).Language).Name = Language
+                      and then not Src_Data.Locally_Removed
+                      and then Src_Data.Replaced_By = No_Source
+                      and then Src_Data.Path.Name /= No_Path
+                  then
+                     if Src_Data.Unit /= No_Name then
+                        Get_Name_String (Src_Data.Unit);
 
-      for Proj in Present'Range loop
-         if Present (Proj) then
-            Source := In_Tree.Projects.Table (Proj).First_Source;
-            while Source /= No_Source loop
-               Src_Data := In_Tree.Sources.Table (Source);
+                        if Src_Data.Kind = Spec then
+                           Suffix :=
+                             In_Tree.Languages_Data.Table
+                               (Src_Data.Language).Config.Mapping_Spec_Suffix;
+                        else
+                           Suffix :=
+                             In_Tree.Languages_Data.Table
+                               (Src_Data.Language).Config.Mapping_Body_Suffix;
+                        end if;
 
-               if In_Tree.Languages_Data.Table
-                 (In_Tree.Sources.Table (Source).Language).Name = Language
-                   and then not Src_Data.Locally_Removed
-                   and then Src_Data.Replaced_By = No_Source
-                   and then Src_Data.Path.Name /= No_Path
-               then
-                  if Src_Data.Unit /= No_Name then
-                     Get_Name_String (Src_Data.Unit);
+                        if Suffix /= No_File then
+                           Add_Str_To_Name_Buffer (Get_Name_String (Suffix));
+                        end if;
 
-                     if Src_Data.Kind = Spec then
-                        Suffix :=
-                          In_Tree.Languages_Data.Table
-                            (Src_Data.Language).Config.Mapping_Spec_Suffix;
-                     else
-                        Suffix :=
-                          In_Tree.Languages_Data.Table
-                            (Src_Data.Language).Config.Mapping_Body_Suffix;
+                        Put_Name_Buffer;
                      end if;
 
-                     if Suffix /= No_File then
-                        Add_Str_To_Name_Buffer (Get_Name_String (Suffix));
-                     end if;
+                     Get_Name_String (Src_Data.File);
+                     Put_Name_Buffer;
 
+                     Get_Name_String (Src_Data.Path.Name);
                      Put_Name_Buffer;
                   end if;
 
-                  Get_Name_String (Src_Data.File);
-                  Put_Name_Buffer;
-
-                  Get_Name_String (Src_Data.Path.Name);
-                  Put_Name_Buffer;
-               end if;
-
-               Source := Src_Data.Next_In_Project;
-            end loop;
-         end if;
-      end loop;
+                  Source := Src_Data.Next_In_Project;
+               end loop;
+            end if;
+         end loop;
+      end if;
 
       GNAT.OS_Lib.Close (File, Status);
 
       if not Status then
-         Prj.Com.Fail ("disk full");
+         Prj.Com.Fail ("disk full, could not create mapping file");
+         --  Do we know this is disk full? Or could it be e.g. a protection
+         --  problem of some kind preventing creation of the file ???
       end if;
    end Create_Mapping_File;
 

diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads
index b4aa8e4fa5e1dadac3d27d4cf605a33475aec8e8..dbce7b648ca7d8637a6be06f464f7e77bb8c7089 100644 (file)
--- a/gcc/ada/prj-env.ads
+++ b/gcc/ada/prj-env.ads
@@ -40,31 +40,28 @@ package Prj.Env is
    --  of package Fmap), so that Osint.Find_File will find the correct path
    --  corresponding to a source.
 
-   procedure Create_Mapping_File
-     (Project : Project_Id;
-      In_Tree : Project_Tree_Ref;
-      Name    : out Path_Name_Type);
-   --  Create a temporary mapping file for project Project. For each unit
-   --  in the closure of immediate sources of Project, put the mapping of
-   --  its spec and or body to its file name and path name in this file.
-
    procedure Create_Mapping_File
      (Project  : Project_Id;
-      Language : Name_Id;
+      Language : Name_Id := No_Name;
       In_Tree  : Project_Tree_Ref;
       Name     : out Path_Name_Type);
    --  Create a temporary mapping file for project Project. For each source or
    --  template of Language in the Project, put the mapping of its file
    --  name and path name in this file.
    --
+   --  This function either looks at all the source files for the specified
+   --  language in the project, or if Language is set to No_Name, at all
+   --  units in the project.
+   --
    --  Implementation note: we pass a language name, not a language_index here,
    --  since the latter would have to match exactly the index of that language
    --  for the specified project, and that is not information available in
-   --  buildgpr.adb
+   --  buildgpr.adb.
 
    procedure Set_Mapping_File_Initial_State_To_Empty;
-   --  When creating a mapping file, create an empty map. This case occurs
-   --  when run time source files are found in the project files.
+   --  When creating a mapping file, create an empty map. This case occurs when
+   --  run time source files are found in the project files. This only applies
+   --  to the Ada_Only mode.
 
    procedure Create_Config_Pragmas_File
      (For_Project          : Project_Id;
@@ -97,11 +94,11 @@ package Prj.Env is
      (Project   : Project_Id;
       In_Tree   : Project_Tree_Ref;
       Recursive : Boolean) return String;
-   --  Get the source search path of a Project file. If Recursive it True,
-   --  get all the source directories of the imported and modified project
-   --  files (recursively). If Recursive is False, just get the path for the
-   --  source directories of Project. Note: the resulting String may be empty
-   --  if there is no source directory in the project file.
+   --  Get the source search path of a Project file. If Recursive it True, get
+   --  all the source directories of the imported and modified project files
+   --  (recursively). If Recursive is False, just get the path for the source
+   --  directories of Project. Note: the resulting String may be empty if there
+   --  is no source directory in the project file.
 
    function Ada_Objects_Path
      (Project             : Project_Id;
@@ -115,18 +112,17 @@ package Prj.Env is
      (Project             : Project_Id;
       In_Tree             : Project_Tree_Ref;
       Including_Libraries : Boolean);
-   --  Set the env vars for additional project path files, after
+   --  Set the environment variables for additional project path files, after
    --  creating the path files if necessary.
 
    procedure Delete_All_Path_Files (In_Tree : Project_Tree_Ref);
-   --  Delete all temporary path files that have been created by
-   --  calls to Set_Ada_Paths.
+   --  Delete all temporary path files that have been created by Set_Ada_Paths
 
    function Path_Name_Of_Library_Unit_Body
      (Name    : String;
       Project : Project_Id;
       In_Tree : Project_Tree_Ref) return String;
-   --  Returns the Path of a library unit
+   --  Returns the path of a library unit
 
    function File_Name_Of_Library_Unit_Body
      (Name              : String;
@@ -169,8 +165,8 @@ package Prj.Env is
    procedure For_All_Source_Dirs
      (Project : Project_Id;
       In_Tree : Project_Tree_Ref);
-   --  Iterate through all the source directories of a project, including
-   --  those of imported or modified projects.
+   --  Iterate through all the source directories of a project, including those
+   --  of imported or modified projects.
 
    generic
       with procedure Action (Path : String);

diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index 4b282243b3b101c945829a6a9a2d0c42fa042327..daff8ef30eeb128cd916db802f35986d7f243822 100644 (file)
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -72,9 +72,10 @@ package body Prj.Nmsc is
       Except   : Boolean := False;
       Found    : Boolean := False;
    end record;
-   --  Information about file names found in string list attribute
-   --  Source_Files or in a source list file, stored in hash table
+   --  Information about file names found in string list attribute:
+   --  Source_Files or in a source list file, stored in hash table.
    --  Source_Names, used by procedure Get_Path_Names_And_Record_Sources.
+   --  Except is set to True if source is a naming exception in the project.
 
    No_Name_Location : constant Name_Location :=
                         (Name     => No_File,
@@ -3264,7 +3265,7 @@ package body Prj.Nmsc is
 
          Write_Attr ("Body_Suffix", Get_Name_String (Body_Suffix));
 
-         --  We'll need the dot replacement below, so compute it now.
+         --  We'll need the dot replacement below, so compute it now
 
          Check_Common
            (Dot_Replacement => Data.Naming.Dot_Replacement,

diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb
index db6ea7f81fafa8c6784cc6e81e13890cd235b385..966f40870dbb25fce72efe6c7c4dd0eaa2363462 100644 (file)
--- a/gcc/ada/prj.adb
+++ b/gcc/ada/prj.adb
@@ -116,7 +116,6 @@ package body Prj is
                       Imported_Directories_Switches  => null,
                       Include_Path                   => null,
                       Include_Data_Set               => False,
-                      Include_Language               => No_Language_Index,
                       Source_Dirs                    => Nil_String,
                       Known_Order_Of_Source_Dirs     => True,
                       Object_Directory               => No_Path_Information,

diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads
index 760a076f6dbc4e0523a6b8f90363ad589662725e..10d023b8e6599be084cb0b3c7ac6c6f6560ad0f1 100644 (file)
--- a/gcc/ada/prj.ads
+++ b/gcc/ada/prj.ads
@@ -1178,8 +1178,6 @@ package Prj is
       --  The list of languages of the sources of this project
       --  mode: Ada_Only
 
-      Include_Language : Language_Index := No_Language_Index;
-
       First_Language_Processing : Language_Index := No_Language_Index;
       --  First index of the language data in the project.
       --  This is an index into the project_tree_data.languages_data