From 2f1e0b61936bee94c65d1c935e2f43a8d46cf9da Mon Sep 17 00:00:00 2001
From: Emmanuel Briot <briot@adacore.com>
Date: Wed, 22 Apr 2009 15:10:29 +0000
Subject: [PATCH] make.adb, [...] (Create_Mapping_File): merge the two versions
for Ada_Only and Multi_Language modes...
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
---
gcc/ada/ChangeLog | 7 +
gcc/ada/make.adb | 10 +-
gcc/ada/prj-env.adb | 302 +++++++++++++------------------------------
gcc/ada/prj-env.ads | 42 +++---
gcc/ada/prj-nmsc.adb | 7 +-
gcc/ada/prj.adb | 1 -
gcc/ada/prj.ads | 2 -
7 files changed, 124 insertions(+), 247 deletions(-)
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a1b8ad128ed0..235cf5386c63 100644
--- 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 559baeb0d46b..168e4f3643d4 100644
--- 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 3be453141429..3b0b1e51e007 100644
--- 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 b4aa8e4fa5e1..dbce7b648ca7 100644
--- 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 4b282243b3b1..daff8ef30eeb 100644
--- 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 db6ea7f81faf..966f40870dbb 100644
--- 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 760a076f6dbc..10d023b8e659 100644
--- 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
--
GitLab