mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-21 00:21:03 +08:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Emmanuel Briot 2009-04-22 15:10:29 +00:00 committed by Arnaud Charlet
parent 35afb01256
commit 2f1e0b6193
7 changed files with 135 additions and 258 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/ada/ChangeLog
View File

@ -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

10
gcc/ada/make.adb
View File

@ -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

324
gcc/ada/prj-env.adb
View File

@ -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,23 +1036,25 @@ 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;
File : File_Descriptor := Invalid_FD;
Status : Boolean;
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.
Source : Source_Id;
Src_Data : Source_Data;
Suffix : File_Name_Type;
The_Unit_Data : Unit_Data;
Data : File_Name_Data;
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;
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,158 +1113,12 @@ package body Prj.Env is
Get_Name_String (Data.Path.Name);
Put_Name_Buffer;
end Put_Data;
--------------------
-- 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 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");
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;
if Fill_Mapping_File then
-- For all units in table Units
for Unit in 1 .. Unit_Table.Last (In_Tree.Units) loop
The_Unit_Data := In_Tree.Units.Table (Unit);
-- If the unit has a valid name
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;
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 Data.Name /= No_File and then Present (Data.Project) then
Put_Data (Spec => False);
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;
@ -1276,29 +1127,18 @@ package body Prj.Env is
-- Nothing to do for non existent project or project that has already
-- been flagged.
if Prj = No_Project or else Present (Prj) then
return;
if Prj /= No_Project and then not Present (Prj) then
Present (Prj) := True;
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);
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
@ -1325,56 +1165,90 @@ package body Prj.Env is
end if;
end if;
-- For all source of the Language of all projects in the closure
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 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);
-- Case of unit has a valid name
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 The_Unit_Data.Name /= No_Name then
Data := The_Unit_Data.File_Names (Specification);
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;
-- 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;
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 Data.Name /= No_File and then Present (Data.Project) then
Put_Data (Spec => False);
end if;
end if;
end loop;
end if;
-- If language is defined
else
-- 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);
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 Suffix /= No_File then
Add_Str_To_Name_Buffer (Get_Name_String (Suffix));
end if;
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;

42
gcc/ada/prj-env.ads
View File

@ -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);

7
gcc/ada/prj-nmsc.adb
View File

@ -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,

1
gcc/ada/prj.adb
View File

@ -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,

2
gcc/ada/prj.ads
View File

@ -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