-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2006, 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- --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
with Osint; use Osint;
with Output; use Output;
with Prj.Com; use Prj.Com;
-with Table;
with Tempdir;
-with GNAT.OS_Lib; use GNAT.OS_Lib;
+with GNAT.Directory_Operations; use GNAT.Directory_Operations;
package body Prj.Env is
- type Naming_Id is new Nat;
-
Current_Source_Path_File : Name_Id := No_Name;
-- Current value of project source path file env var.
-- Used to avoid setting the env var to the same value.
-- and ADA_OBJECTS_PATH are stored.
Ada_Path_Length : Natural := 0;
- -- Index of the last valid character in Ada_Path_Buffer.
+ -- Index of the last valid character in Ada_Path_Buffer
Ada_Prj_Include_File_Set : Boolean := False;
Ada_Prj_Objects_File_Set : Boolean := False;
-- platforms, except on VMS where the logical names are deassigned, thus
-- avoiding the pollution of the environment of the caller.
- package Namings is new Table.Table
- (Table_Component_Type => Naming_Data,
- Table_Index_Type => Naming_Id,
- Table_Low_Bound => 1,
- Table_Initial => 5,
- Table_Increment => 100,
- Table_Name => "Prj.Env.Namings");
-
- Default_Naming : constant Naming_Id := Namings.First;
+ Default_Naming : constant Naming_Id := Naming_Table.First;
Fill_Mapping_File : Boolean := True;
- package Path_Files is new Table.Table
- (Table_Component_Type => Name_Id,
- Table_Index_Type => Natural,
- Table_Low_Bound => 1,
- Table_Initial => 50,
- Table_Increment => 50,
- Table_Name => "Prj.Env.Path_Files");
- -- Table storing all the temp path file names.
- -- Used by Delete_All_Path_Files.
-
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.
- package Source_Paths is new Table.Table
- (Table_Component_Type => Name_Id,
- Table_Index_Type => Natural,
- Table_Low_Bound => 1,
- Table_Initial => 50,
- Table_Increment => 50,
- Table_Name => "Prj.Env.Source_Paths");
- -- A table to store the source dirs before creating the source path file
-
- package Object_Paths is new Table.Table
- (Table_Component_Type => Name_Id,
- Table_Index_Type => Natural,
- Table_Low_Bound => 1,
- Table_Initial => 50,
- Table_Increment => 50,
- Table_Name => "Prj.Env.Source_Paths");
- -- A table to store the object dirs, before creating the object path file
-
-----------------------
-- Local Subprograms --
-----------------------
- function Body_Path_Name_Of (Unit : Unit_Id) return String;
+ function Body_Path_Name_Of
+ (Unit : Unit_Id;
+ In_Tree : Project_Tree_Ref) return String;
-- Returns the path name of the body of a unit.
-- Compute it first, if necessary.
- function Spec_Path_Name_Of (Unit : Unit_Id) return String;
+ function Spec_Path_Name_Of
+ (Unit : Unit_Id;
+ In_Tree : Project_Tree_Ref) return String;
-- Returns the path name of the spec of a unit.
-- Compute it first, if necessary.
- procedure Add_To_Path (Source_Dirs : String_List_Id);
+ procedure Add_To_Path
+ (Source_Dirs : String_List_Id;
+ In_Tree : Project_Tree_Ref);
-- Add to Ada_Path_Buffer all the source directories in string list
-- Source_Dirs, if any. Increment Ada_Path_Length.
-- If Ada_Path_Length /= 0, prepend a Path_Separator character to
-- Path.
- procedure Add_To_Source_Path (Source_Dirs : String_List_Id);
+ procedure Add_To_Source_Path
+ (Source_Dirs : String_List_Id; In_Tree : Project_Tree_Ref);
-- Add to Ada_Path_B all the source directories in string list
-- Source_Dirs, if any. Increment Ada_Path_Length.
- procedure Add_To_Object_Path (Object_Dir : Name_Id);
+ procedure Add_To_Object_Path
+ (Object_Dir : Name_Id;
+ In_Tree : Project_Tree_Ref);
-- Add Object_Dir to object path table. Make sure it is not duplicate
-- and it is the last one in the current table.
+ function Contains_ALI_Files (Dir : Name_Id) return Boolean;
+ -- Return True if there is at least one ALI file in the directory Dir
+
procedure Create_New_Path_File
- (Path_FD : out File_Descriptor;
+ (In_Tree : Project_Tree_Ref;
+ Path_FD : out File_Descriptor;
Path_Name : out Name_Id);
-- Create a new temporary path file. Get the file name in Path_Name.
-- The name is normally obtained by increasing the number in
procedure Set_Path_File_Var (Name : String; Value : String);
-- Call Setenv, after calling To_Host_File_Spec
- function Ultimate_Extension_Of (Project : in Project_Id) return Project_Id;
+ function Ultimate_Extension_Of
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref) return Project_Id;
-- Return a project that is either Project or an extended ancestor of
-- Project that itself is not extended.
-- Ada_Include_Path --
----------------------
- function Ada_Include_Path (Project : Project_Id) return String_Access is
+ function Ada_Include_Path
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref) return String_Access is
procedure Add (Project : Project_Id);
-- Add all the source directories of a project to the path only if
begin
-- If Seen is empty, then the project cannot have been visited
- if not Projects.Table (Project).Seen then
- Projects.Table (Project).Seen := True;
+ if not In_Tree.Projects.Table (Project).Seen then
+ In_Tree.Projects.Table (Project).Seen := True;
declare
- Data : constant Project_Data := Projects.Table (Project);
+ Data : constant Project_Data :=
+ In_Tree.Projects.Table (Project);
List : Project_List := Data.Imported_Projects;
begin
-- Add to path all source directories of this project
- Add_To_Path (Data.Source_Dirs);
+ Add_To_Path (Data.Source_Dirs, In_Tree);
-- Call Add to the project being extended, if any
-- Call Add for each imported project, if any
while List /= Empty_Project_List loop
- Add (Project_Lists.Table (List).Project);
- List := Project_Lists.Table (List).Next;
+ Add
+ (In_Tree.Project_Lists.Table (List).Project);
+ List := In_Tree.Project_Lists.Table (List).Next;
end loop;
end;
end if;
-- If it is the first time we call this function for
-- this project, compute the source path
- if Projects.Table (Project).Ada_Include_Path = null then
+ if
+ In_Tree.Projects.Table (Project).Ada_Include_Path = null
+ then
Ada_Path_Length := 0;
- for Index in 1 .. Projects.Last loop
- Projects.Table (Index).Seen := False;
+ for Index in Project_Table.First ..
+ Project_Table.Last (In_Tree.Projects)
+ loop
+ In_Tree.Projects.Table (Index).Seen := False;
end loop;
Add (Project);
- Projects.Table (Project).Ada_Include_Path :=
+ In_Tree.Projects.Table (Project).Ada_Include_Path :=
new String'(Ada_Path_Buffer (1 .. Ada_Path_Length));
end if;
- return Projects.Table (Project).Ada_Include_Path;
+ return In_Tree.Projects.Table (Project).Ada_Include_Path;
end Ada_Include_Path;
----------------------
function Ada_Include_Path
(Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
Recursive : Boolean) return String
is
begin
if Recursive then
- return Ada_Include_Path (Project).all;
+ return Ada_Include_Path (Project, In_Tree).all;
else
Ada_Path_Length := 0;
- Add_To_Path (Projects.Table (Project).Source_Dirs);
+ Add_To_Path
+ (In_Tree.Projects.Table (Project).Source_Dirs, In_Tree);
return Ada_Path_Buffer (1 .. Ada_Path_Length);
end if;
end Ada_Include_Path;
function Ada_Objects_Path
(Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
Including_Libraries : Boolean := True) return String_Access
is
procedure Add (Project : Project_Id);
begin
-- If this project has not been seen yet
- if not Projects.Table (Project).Seen then
- Projects.Table (Project).Seen := True;
+ if not In_Tree.Projects.Table (Project).Seen then
+ In_Tree.Projects.Table (Project).Seen := True;
declare
- Data : constant Project_Data := Projects.Table (Project);
+ Data : constant Project_Data :=
+ In_Tree.Projects.Table (Project);
List : Project_List := Data.Imported_Projects;
begin
and then
(not Including_Libraries or else not Data.Library))
then
- -- For a library project, add the library directory
+ -- For a library project, add the library directory,
+ -- if there is no object directory or if it contains ALI
+ -- files; otherwise add the object directory.
if Data.Library then
- Add_To_Path (Get_Name_String (Data.Library_Dir));
+ if Data.Object_Directory = No_Name
+ or else
+ Contains_ALI_Files (Data.Library_ALI_Dir)
+ then
+ Add_To_Path (Get_Name_String (Data.Library_ALI_Dir));
+ else
+ Add_To_Path (Get_Name_String (Data.Object_Directory));
+ end if;
else
-- For a non library project, add the object directory
-- Call Add for each imported project, if any
while List /= Empty_Project_List loop
- Add (Project_Lists.Table (List).Project);
- List := Project_Lists.Table (List).Next;
+ Add
+ (In_Tree.Project_Lists.Table (List).Project);
+ List := In_Tree.Project_Lists.Table (List).Next;
end loop;
end;
-- If it is the first time we call this function for
-- this project, compute the objects path
- if Projects.Table (Project).Ada_Objects_Path = null then
+ if
+ In_Tree.Projects.Table (Project).Ada_Objects_Path = null
+ then
Ada_Path_Length := 0;
- for Index in 1 .. Projects.Last loop
- Projects.Table (Index).Seen := False;
+ for Index in Project_Table.First ..
+ Project_Table.Last (In_Tree.Projects)
+ loop
+ In_Tree.Projects.Table (Index).Seen := False;
end loop;
Add (Project);
- Projects.Table (Project).Ada_Objects_Path :=
+ In_Tree.Projects.Table (Project).Ada_Objects_Path :=
new String'(Ada_Path_Buffer (1 .. Ada_Path_Length));
end if;
- return Projects.Table (Project).Ada_Objects_Path;
+ return In_Tree.Projects.Table (Project).Ada_Objects_Path;
end Ada_Objects_Path;
------------------------
-- Add_To_Object_Path --
------------------------
- procedure Add_To_Object_Path (Object_Dir : Name_Id) is
+ procedure Add_To_Object_Path
+ (Object_Dir : Name_Id; In_Tree : Project_Tree_Ref)
+ is
begin
-- Check if the directory is already in the table
- for Index in 1 .. Object_Paths.Last loop
+ for Index in Object_Path_Table.First ..
+ Object_Path_Table.Last (In_Tree.Private_Part.Object_Paths)
+ loop
-- If it is, remove it, and add it as the last one
- if Object_Paths.Table (Index) = Object_Dir then
- for Index2 in Index + 1 .. Object_Paths.Last loop
- Object_Paths.Table (Index2 - 1) :=
- Object_Paths.Table (Index2);
+ if In_Tree.Private_Part.Object_Paths.Table (Index) = Object_Dir then
+ for Index2 in Index + 1 ..
+ Object_Path_Table.Last
+ (In_Tree.Private_Part.Object_Paths)
+ loop
+ In_Tree.Private_Part.Object_Paths.Table (Index2 - 1) :=
+ In_Tree.Private_Part.Object_Paths.Table (Index2);
end loop;
- Object_Paths.Table (Object_Paths.Last) := Object_Dir;
+ In_Tree.Private_Part.Object_Paths.Table
+ (Object_Path_Table.Last (In_Tree.Private_Part.Object_Paths)) :=
+ Object_Dir;
return;
end if;
end loop;
-- The directory is not already in the table, add it
- Object_Paths.Increment_Last;
- Object_Paths.Table (Object_Paths.Last) := Object_Dir;
+ Object_Path_Table.Increment_Last (In_Tree.Private_Part.Object_Paths);
+ In_Tree.Private_Part.Object_Paths.Table
+ (Object_Path_Table.Last (In_Tree.Private_Part.Object_Paths)) :=
+ Object_Dir;
end Add_To_Object_Path;
-----------------
-- Add_To_Path --
-----------------
- procedure Add_To_Path (Source_Dirs : String_List_Id) is
+ procedure Add_To_Path
+ (Source_Dirs : String_List_Id;
+ In_Tree : Project_Tree_Ref)
+ is
Current : String_List_Id := Source_Dirs;
Source_Dir : String_Element;
begin
while Current /= Nil_String loop
- Source_Dir := String_Elements.Table (Current);
+ Source_Dir := In_Tree.String_Elements.Table (Current);
Add_To_Path (Get_Name_String (Source_Dir.Display_Value));
Current := Source_Dir.Next;
end loop;
-- Add_To_Source_Path --
------------------------
- procedure Add_To_Source_Path (Source_Dirs : String_List_Id) is
+ procedure Add_To_Source_Path
+ (Source_Dirs : String_List_Id; In_Tree : Project_Tree_Ref)
+ is
Current : String_List_Id := Source_Dirs;
Source_Dir : String_Element;
Add_It : Boolean;
-- Add each source directory
while Current /= Nil_String loop
- Source_Dir := String_Elements.Table (Current);
+ Source_Dir := In_Tree.String_Elements.Table (Current);
Add_It := True;
-- Check if the source directory is already in the table
- for Index in 1 .. Source_Paths.Last loop
+ for Index in Source_Path_Table.First ..
+ Source_Path_Table.Last
+ (In_Tree.Private_Part.Source_Paths)
+ loop
-- If it is already, no need to add it
- if Source_Paths.Table (Index) = Source_Dir.Value then
+ if In_Tree.Private_Part.Source_Paths.Table (Index) =
+ Source_Dir.Value
+ then
Add_It := False;
exit;
end if;
end loop;
if Add_It then
- Source_Paths.Increment_Last;
- Source_Paths.Table (Source_Paths.Last) := Source_Dir.Value;
+ Source_Path_Table.Increment_Last
+ (In_Tree.Private_Part.Source_Paths);
+ In_Tree.Private_Part.Source_Paths.Table
+ (Source_Path_Table.Last (In_Tree.Private_Part.Source_Paths)) :=
+ Source_Dir.Value;
end if;
-- Next source directory
-- Body_Path_Name_Of --
-----------------------
- function Body_Path_Name_Of (Unit : Unit_Id) return String is
- Data : Unit_Data := Units.Table (Unit);
+ function Body_Path_Name_Of
+ (Unit : Unit_Id; In_Tree : Project_Tree_Ref) return String
+ is
+ Data : Unit_Data := In_Tree.Units.Table (Unit);
begin
-- If we don't know the path name of the body of this unit,
if Data.File_Names (Body_Part).Path = No_Name then
declare
Current_Source : String_List_Id :=
- Projects.Table (Data.File_Names (Body_Part).Project).Sources;
+ In_Tree.Projects.Table
+ (Data.File_Names (Body_Part).Project).Sources;
Path : GNAT.OS_Lib.String_Access;
begin
(Namet.Get_Name_String
(Data.File_Names (Body_Part).Name),
Namet.Get_Name_String
- (String_Elements.Table (Current_Source).Value));
+ (In_Tree.String_Elements.Table
+ (Current_Source).Value));
- -- If the file is in this directory,
- -- then we store the path, and we are done.
+ -- If the file is in this directory, then we store the path,
+ -- and we are done.
if Path /= null then
Name_Len := Path'Length;
else
Current_Source :=
- String_Elements.Table (Current_Source).Next;
+ In_Tree.String_Elements.Table
+ (Current_Source).Next;
end if;
end loop;
- Units.Table (Unit) := Data;
+ In_Tree.Units.Table (Unit) := Data;
end;
end if;
return Namet.Get_Name_String (Data.File_Names (Body_Part).Path);
end Body_Path_Name_Of;
+ ------------------------
+ -- Contains_ALI_Files --
+ ------------------------
+
+ function Contains_ALI_Files (Dir : Name_Id) return Boolean is
+ Dir_Name : constant String := Get_Name_String (Dir);
+ Direct : Dir_Type;
+ Name : String (1 .. 1_000);
+ Last : Natural;
+ Result : Boolean := False;
+
+ begin
+ Open (Direct, Dir_Name);
+
+ -- For each file in the directory, check if it is an ALI file
+
+ loop
+ Read (Direct, Name, Last);
+ exit when Last = 0;
+ Canonical_Case_File_Name (Name (1 .. Last));
+ Result := Last >= 5 and then Name (Last - 3 .. Last) = ".ali";
+ exit when Result;
+ end loop;
+
+ Close (Direct);
+ return Result;
+
+ exception
+ -- If there is any problem, close the directory if open and return
+ -- True; the library directory will be added to the path.
+
+ when others =>
+ if Is_Open (Direct) then
+ Close (Direct);
+ end if;
+
+ return True;
+ end Contains_ALI_Files;
+
--------------------------------
-- Create_Config_Pragmas_File --
--------------------------------
procedure Create_Config_Pragmas_File
(For_Project : Project_Id;
Main_Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
Include_Config_Files : Boolean := True)
is
pragma Unreferenced (Main_Project);
File_Name : Name_Id := No_Name;
File : File_Descriptor := Invalid_FD;
- Current_Unit : Unit_Id := Units.First;
+ Current_Unit : Unit_Id := Unit_Table.First;
First_Project : Project_List := Empty_Project_List;
-----------
procedure Check (Project : Project_Id) is
- Data : constant Project_Data := Projects.Table (Project);
+ Data : constant Project_Data :=
+ In_Tree.Projects.Table (Project);
begin
if Current_Verbosity = High then
Current_Project := First_Project;
while Current_Project /= Empty_Project_List
- and then Project_Lists.Table (Current_Project).Project /= Project
+ and then In_Tree.Project_Lists.Table
+ (Current_Project).Project /= Project
loop
- Current_Project := Project_Lists.Table (Current_Project).Next;
+ Current_Project :=
+ In_Tree.Project_Lists.Table (Current_Project).Next;
end loop;
-- If it is not, put it in the list, and visit it
if Current_Project = Empty_Project_List then
- Project_Lists.Increment_Last;
- Project_Lists.Table (Project_Lists.Last) :=
- (Project => Project, Next => First_Project);
- First_Project := Project_Lists.Last;
+ Project_List_Table.Increment_Last
+ (In_Tree.Project_Lists);
+ In_Tree.Project_Lists.Table
+ (Project_List_Table.Last (In_Tree.Project_Lists)) :=
+ (Project => Project, Next => First_Project);
+ First_Project :=
+ Project_List_Table.Last (In_Tree.Project_Lists);
-- Is the naming scheme of this project one that we know?
Current_Naming := Default_Naming;
- while Current_Naming <= Namings.Last and then
- not Same_Naming_Scheme
- (Left => Namings.Table (Current_Naming),
+ while Current_Naming <=
+ Naming_Table.Last (In_Tree.Private_Part.Namings)
+ and then not Same_Naming_Scheme
+ (Left => In_Tree.Private_Part.Namings.Table (Current_Naming),
Right => Data.Naming) loop
Current_Naming := Current_Naming + 1;
end loop;
-- If we don't know it, add it
- if Current_Naming > Namings.Last then
- Namings.Increment_Last;
- Namings.Table (Namings.Last) := Data.Naming;
+ if Current_Naming >
+ Naming_Table.Last (In_Tree.Private_Part.Namings)
+ then
+ Naming_Table.Increment_Last (In_Tree.Private_Part.Namings);
+ In_Tree.Private_Part.Namings.Table
+ (Naming_Table.Last (In_Tree.Private_Part.Namings)) :=
+ Data.Naming;
-- We need a temporary file to be created
(File, "pragma Source_File_Name_Project");
Put_Line
(File, " (Spec_File_Name => ""*" &
- Namet.Get_Name_String (Data.Naming.Current_Spec_Suffix) &
+ Namet.Get_Name_String (Data.Naming.Ada_Spec_Suffix) &
""",");
Put_Line
(File, " Casing => " &
(File, "pragma Source_File_Name_Project");
Put_Line
(File, " (Body_File_Name => ""*" &
- Namet.Get_Name_String (Data.Naming.Current_Body_Suffix) &
+ Namet.Get_Name_String (Data.Naming.Ada_Body_Suffix) &
""",");
Put_Line
(File, " Casing => " &
-- and maybe separate
if
- Data.Naming.Current_Body_Suffix /= Data.Naming.Separate_Suffix
+ Data.Naming.Ada_Body_Suffix /= Data.Naming.Separate_Suffix
then
Put_Line
(File, "pragma Source_File_Name_Project");
begin
while Current /= Empty_Project_List loop
- Check (Project_Lists.Table (Current).Project);
- Current := Project_Lists.Table (Current).Next;
+ Check
+ (In_Tree.Project_Lists.Table
+ (Current).Project);
+ Current := In_Tree.Project_Lists.Table
+ (Current).Next;
end loop;
end;
end if;
-- Start of processing for Create_Config_Pragmas_File
begin
- if not Projects.Table (For_Project).Config_Checked then
+ if not
+ In_Tree.Projects.Table (For_Project).Config_Checked
+ then
-- Remove any memory of processed naming schemes, if any
- Namings.Set_Last (Default_Naming);
+ Naming_Table.Set_Last (In_Tree.Private_Part.Namings, Default_Naming);
-- Check the naming schemes
-- Visit all the units and process those that need an SFN pragma
- while Current_Unit <= Units.Last loop
+ while
+ Current_Unit <= Unit_Table.Last (In_Tree.Units)
+ loop
declare
Unit : constant Unit_Data :=
- Units.Table (Current_Unit);
+ In_Tree.Units.Table (Current_Unit);
begin
if Unit.File_Names (Specification).Needs_Pragma then
Write_Line ("""");
end if;
- Projects.Table (For_Project).Config_File_Name := File_Name;
- Projects.Table (For_Project).Config_File_Temp := True;
+ In_Tree.Projects.Table (For_Project).Config_File_Name :=
+ File_Name;
+ In_Tree.Projects.Table (For_Project).Config_File_Temp :=
+ True;
- Projects.Table (For_Project).Config_Checked := True;
+ In_Tree.Projects.Table (For_Project).Config_Checked :=
+ True;
end if;
end Create_Config_Pragmas_File;
procedure Create_Mapping_File
(Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
Name : out Name_Id)
is
File : File_Descriptor := Invalid_FD;
Status : Boolean;
-- For call to Close
- Present : Project_Flags (No_Project .. Projects.Last) :=
+ 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;
-- Flag the current project
Present (Prj) := True;
- Imported := Projects.Table (Prj).Imported_Projects;
+ Imported :=
+ In_Tree.Projects.Table (Prj).Imported_Projects;
-- Call itself for each project directly imported
while Imported /= Empty_Project_List loop
- Proj := Project_Lists.Table (Imported).Project;
- Imported := Project_Lists.Table (Imported).Next;
+ 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 (Projects.Table (Prj).Extends);
+ Recursive_Flag (In_Tree.Projects.Table (Prj).Extends);
end Recursive_Flag;
-- Start of processing for Create_Mapping_File
end if;
if Fill_Mapping_File then
+
-- For all units in table Units
- for Unit in 1 .. Units.Last loop
- The_Unit_Data := Units.Table (Unit);
+ 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
--------------------------
procedure Create_New_Path_File
- (Path_FD : out File_Descriptor;
+ (In_Tree : Project_Tree_Ref;
+ Path_FD : out File_Descriptor;
Path_Name : out Name_Id)
is
begin
-- Record the name, so that the temp path file will be deleted
-- at the end of the program.
- Path_Files.Increment_Last;
- Path_Files.Table (Path_Files.Last) := Path_Name;
+ Path_File_Table.Increment_Last (In_Tree.Private_Part.Path_Files);
+ In_Tree.Private_Part.Path_Files.Table
+ (Path_File_Table.Last (In_Tree.Private_Part.Path_Files)) :=
+ Path_Name;
end if;
end Create_New_Path_File;
-- Delete_All_Path_Files --
---------------------------
- procedure Delete_All_Path_Files is
+ procedure Delete_All_Path_Files (In_Tree : Project_Tree_Ref) is
Disregard : Boolean := True;
begin
- for Index in 1 .. Path_Files.Last loop
- if Path_Files.Table (Index) /= No_Name then
+ for Index in Path_File_Table.First ..
+ Path_File_Table.Last (In_Tree.Private_Part.Path_Files)
+ loop
+ if In_Tree.Private_Part.Path_Files.Table (Index) /= No_Name then
Delete_File
- (Get_Name_String (Path_Files.Table (Index)), Disregard);
+ (Get_Name_String
+ (In_Tree.Private_Part.Path_Files.Table (Index)),
+ Disregard);
end if;
end loop;
function File_Name_Of_Library_Unit_Body
(Name : String;
Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
Main_Project_Only : Boolean := True;
Full_Path : Boolean := False) return String
is
The_Project : Project_Id := Project;
- Data : Project_Data := Projects.Table (Project);
+ Data : Project_Data :=
+ In_Tree.Projects.Table (Project);
Original_Name : String := Name;
Extended_Spec_Name : String :=
Name & Namet.Get_Name_String
- (Data.Naming.Current_Spec_Suffix);
+ (Data.Naming.Ada_Spec_Suffix);
Extended_Body_Name : String :=
Name & Namet.Get_Name_String
- (Data.Naming.Current_Body_Suffix);
+ (Data.Naming.Ada_Body_Suffix);
Unit : Unit_Data;
-- Loop through units
-- Should have comment explaining reverse ???
- for Current in reverse Units.First .. Units.Last loop
- Unit := Units.Table (Current);
+ for Current in reverse Unit_Table.First ..
+ Unit_Table.Last (In_Tree.Units)
+ loop
+ Unit := In_Tree.Units.Table (Current);
-- Check for body
-- Otherwise, look in the project we are extending
The_Project := Data.Extends;
- Data := Projects.Table (The_Project);
+ Data := In_Tree.Projects.Table (The_Project);
end loop;
-- We don't know this file name, return an empty string
-- For_All_Object_Dirs --
-------------------------
- procedure For_All_Object_Dirs (Project : Project_Id) is
+ procedure For_All_Object_Dirs
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref)
+ is
Seen : Project_List := Empty_Project_List;
procedure Add (Project : Project_Id);
---------
procedure Add (Project : Project_Id) is
- Data : constant Project_Data := Projects.Table (Project);
+ Data : constant Project_Data :=
+ In_Tree.Projects.Table (Project);
List : Project_List := Data.Imported_Projects;
begin
-- for sure we never visited this project.
if Seen = Empty_Project_List then
- Project_Lists.Increment_Last;
- Seen := Project_Lists.Last;
- Project_Lists.Table (Seen) :=
+ Project_List_Table.Increment_Last
+ (In_Tree.Project_Lists);
+ Seen :=
+ Project_List_Table.Last (In_Tree.Project_Lists);
+ In_Tree.Project_Lists.Table (Seen) :=
(Project => Project, Next => Empty_Project_List);
else
loop
-- If it is, then there is nothing else to do
- if Project_Lists.Table (Current).Project = Project then
+ if In_Tree.Project_Lists.Table
+ (Current).Project = Project
+ then
return;
end if;
- exit when Project_Lists.Table (Current).Next =
- Empty_Project_List;
- Current := Project_Lists.Table (Current).Next;
+ exit when
+ In_Tree.Project_Lists.Table (Current).Next =
+ Empty_Project_List;
+ Current :=
+ In_Tree.Project_Lists.Table (Current).Next;
end loop;
-- This project has never been visited, add it
-- to the list.
- Project_Lists.Increment_Last;
- Project_Lists.Table (Current).Next := Project_Lists.Last;
- Project_Lists.Table (Project_Lists.Last) :=
+ Project_List_Table.Increment_Last
+ (In_Tree.Project_Lists);
+ In_Tree.Project_Lists.Table (Current).Next :=
+ Project_List_Table.Last (In_Tree.Project_Lists);
+ In_Tree.Project_Lists.Table
+ (Project_List_Table.Last
+ (In_Tree.Project_Lists)) :=
(Project => Project, Next => Empty_Project_List);
end;
end if;
-- And visit all imported projects
while List /= Empty_Project_List loop
- Add (Project_Lists.Table (List).Project);
- List := Project_Lists.Table (List).Next;
+ Add (In_Tree.Project_Lists.Table (List).Project);
+ List := In_Tree.Project_Lists.Table (List).Next;
end loop;
end Add;
-- For_All_Source_Dirs --
-------------------------
- procedure For_All_Source_Dirs (Project : Project_Id) is
+ procedure For_All_Source_Dirs
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref)
+ is
Seen : Project_List := Empty_Project_List;
procedure Add (Project : Project_Id);
---------
procedure Add (Project : Project_Id) is
- Data : constant Project_Data := Projects.Table (Project);
+ Data : constant Project_Data :=
+ In_Tree.Projects.Table (Project);
List : Project_List := Data.Imported_Projects;
begin
-- for sure we never visited this project.
if Seen = Empty_Project_List then
- Project_Lists.Increment_Last;
- Seen := Project_Lists.Last;
- Project_Lists.Table (Seen) :=
+ Project_List_Table.Increment_Last
+ (In_Tree.Project_Lists);
+ Seen := Project_List_Table.Last
+ (In_Tree.Project_Lists);
+ In_Tree.Project_Lists.Table (Seen) :=
(Project => Project, Next => Empty_Project_List);
else
loop
-- If it is, then there is nothing else to do
- if Project_Lists.Table (Current).Project = Project then
+ if In_Tree.Project_Lists.Table
+ (Current).Project = Project
+ then
return;
end if;
- exit when Project_Lists.Table (Current).Next =
- Empty_Project_List;
- Current := Project_Lists.Table (Current).Next;
+ exit when
+ In_Tree.Project_Lists.Table (Current).Next =
+ Empty_Project_List;
+ Current :=
+ In_Tree.Project_Lists.Table (Current).Next;
end loop;
-- This project has never been visited, add it
-- to the list.
- Project_Lists.Increment_Last;
- Project_Lists.Table (Current).Next := Project_Lists.Last;
- Project_Lists.Table (Project_Lists.Last) :=
+ Project_List_Table.Increment_Last
+ (In_Tree.Project_Lists);
+ In_Tree.Project_Lists.Table (Current).Next :=
+ Project_List_Table.Last (In_Tree.Project_Lists);
+ In_Tree.Project_Lists.Table
+ (Project_List_Table.Last
+ (In_Tree.Project_Lists)) :=
(Project => Project, Next => Empty_Project_List);
end;
end if;
-- If there are Ada sources, call action with the name of every
-- source directory.
- if Projects.Table (Project).Ada_Sources_Present then
+ if
+ In_Tree.Projects.Table (Project).Ada_Sources_Present
+ then
while Current /= Nil_String loop
- The_String := String_Elements.Table (Current);
+ The_String :=
+ In_Tree.String_Elements.Table (Current);
Action (Get_Name_String (The_String.Value));
Current := The_String.Next;
end loop;
-- And visit all imported projects
while List /= Empty_Project_List loop
- Add (Project_Lists.Table (List).Project);
- List := Project_Lists.Table (List).Next;
+ Add (In_Tree.Project_Lists.Table (List).Project);
+ List := In_Tree.Project_Lists.Table (List).Next;
end loop;
end Add;
procedure Get_Reference
(Source_File_Name : String;
+ In_Tree : Project_Tree_Ref;
Project : out Project_Id;
Path : out Name_Id)
is
begin
Canonical_Case_File_Name (Original_Name);
- for Id in Units.First .. Units.Last loop
- Unit := Units.Table (Id);
+ for Id in Unit_Table.First ..
+ Unit_Table.Last (In_Tree.Units)
+ loop
+ Unit := In_Tree.Units.Table (Id);
if (Unit.File_Names (Specification).Name /= No_Name
and then
Original_Name)
then
Project := Ultimate_Extension_Of
- (Unit.File_Names (Specification).Project);
+ (Project => Unit.File_Names (Specification).Project,
+ In_Tree => In_Tree);
Path := Unit.File_Names (Specification).Display_Path;
if Current_Verbosity > Default then
Original_Name)
then
Project := Ultimate_Extension_Of
- (Unit.File_Names (Body_Part).Project);
+ (Project => Unit.File_Names (Body_Part).Project,
+ In_Tree => In_Tree);
Path := Unit.File_Names (Body_Part).Display_Path;
if Current_Verbosity > Default then
-- Initialize --
----------------
- -- This is a place holder for possible required initialization in
- -- the future. In the current version no initialization is required.
-
procedure Initialize is
begin
- null;
+ Fill_Mapping_File := True;
end Initialize;
------------------------------------
function Path_Name_Of_Library_Unit_Body
(Name : String;
- Project : Project_Id) return String
+ Project : Project_Id;
+ In_Tree : Project_Tree_Ref) return String
is
- Data : constant Project_Data := Projects.Table (Project);
+ Data : constant Project_Data :=
+ In_Tree.Projects.Table (Project);
Original_Name : String := Name;
Extended_Spec_Name : String :=
Name & Namet.Get_Name_String
- (Data.Naming.Current_Spec_Suffix);
+ (Data.Naming.Ada_Spec_Suffix);
Extended_Body_Name : String :=
Name & Namet.Get_Name_String
- (Data.Naming.Current_Body_Suffix);
+ (Data.Naming.Ada_Body_Suffix);
- First : Unit_Id := Units.First;
+ First : Unit_Id := Unit_Table.First;
Current : Unit_Id;
Unit : Unit_Data;
Write_Eol;
end if;
- while First <= Units.Last
- and then Units.Table (First).File_Names (Body_Part).Project /= Project
+ while First <= Unit_Table.Last (In_Tree.Units)
+ and then In_Tree.Units.Table
+ (First).File_Names (Body_Part).Project /= Project
loop
First := First + 1;
end loop;
Current := First;
- while Current <= Units.Last loop
- Unit := Units.Table (Current);
+ while Current <= Unit_Table.Last (In_Tree.Units) loop
+ Unit := In_Tree.Units.Table (Current);
if Unit.File_Names (Body_Part).Project = Project
and then Unit.File_Names (Body_Part).Name /= No_Name
Write_Line (" OK");
end if;
- return Body_Path_Name_Of (Current);
+ return Body_Path_Name_Of (Current, In_Tree);
elsif Current_Name = Extended_Body_Name then
if Current_Verbosity = High then
Write_Line (" OK");
end if;
- return Body_Path_Name_Of (Current);
+ return Body_Path_Name_Of (Current, In_Tree);
else
if Current_Verbosity = High then
Write_Line (" OK");
end if;
- return Spec_Path_Name_Of (Current);
+ return Spec_Path_Name_Of (Current, In_Tree);
elsif Current_Name = Extended_Spec_Name then
if Current_Verbosity = High then
Write_Line (" OK");
end if;
- return Spec_Path_Name_Of (Current);
+ return Spec_Path_Name_Of (Current, In_Tree);
else
if Current_Verbosity = High then
-- Could use some comments in this body ???
- procedure Print_Sources is
+ procedure Print_Sources (In_Tree : Project_Tree_Ref) is
Unit : Unit_Data;
begin
Write_Line ("List of Sources:");
- for Id in Units.First .. Units.Last loop
- Unit := Units.Table (Id);
+ for Id in Unit_Table.First ..
+ Unit_Table.Last (In_Tree.Units)
+ loop
+ Unit := In_Tree.Units.Table (Id);
Write_Str (" ");
Write_Line (Namet.Get_Name_String (Unit.Name));
else
Write_Str (" Project: ");
Get_Name_String
- (Projects.Table
+ (In_Tree.Projects.Table
(Unit.File_Names (Specification).Project).Path_Name);
Write_Line (Name_Buffer (1 .. Name_Len));
end if;
else
Write_Str (" Project: ");
Get_Name_String
- (Projects.Table
+ (In_Tree.Projects.Table
(Unit.File_Names (Body_Part).Project).Path_Name);
Write_Line (Name_Buffer (1 .. Name_Len));
end if;
function Project_Of
(Name : String;
- Main_Project : Project_Id) return Project_Id
+ Main_Project : Project_Id;
+ In_Tree : Project_Tree_Ref) return Project_Id
is
Result : Project_Id := No_Project;
Original_Name : String := Name;
- Data : constant Project_Data := Projects.Table (Main_Project);
+ Data : constant Project_Data :=
+ In_Tree.Projects.Table (Main_Project);
Extended_Spec_Name : String :=
Name & Namet.Get_Name_String
- (Data.Naming.Current_Spec_Suffix);
+ (Data.Naming.Ada_Spec_Suffix);
Extended_Body_Name : String :=
Name & Namet.Get_Name_String
- (Data.Naming.Current_Body_Suffix);
+ (Data.Naming.Ada_Body_Suffix);
Unit : Unit_Data;
Name_Buffer (1 .. Name_Len) := Extended_Body_Name;
The_Body_Name := Name_Find;
- for Current in reverse Units.First .. Units.Last loop
- Unit := Units.Table (Current);
+ for Current in reverse Unit_Table.First ..
+ Unit_Table.Last (In_Tree.Units)
+ loop
+ Unit := In_Tree.Units.Table (Current);
-- Check for body
-- Get the ultimate extending project
if Result /= No_Project then
- while Projects.Table (Result).Extended_By /= No_Project loop
- Result := Projects.Table (Result).Extended_By;
+ while In_Tree.Projects.Table (Result).Extended_By /=
+ No_Project
+ loop
+ Result := In_Tree.Projects.Table (Result).Extended_By;
end loop;
end if;
procedure Set_Ada_Paths
(Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
Including_Libraries : Boolean)
is
Source_FD : File_Descriptor := Invalid_FD;
begin
-- If Seen is False, then the project has not yet been visited
- if not Projects.Table (Project).Seen then
- Projects.Table (Project).Seen := True;
+ if not In_Tree.Projects.Table (Project).Seen then
+ In_Tree.Projects.Table (Project).Seen := True;
declare
- Data : constant Project_Data := Projects.Table (Project);
+ Data : constant Project_Data :=
+ In_Tree.Projects.Table (Project);
List : Project_List := Data.Imported_Projects;
begin
-- Add to path all source directories of this project
-- if there are Ada sources.
- if Projects.Table (Project).Ada_Sources_Present then
- Add_To_Source_Path (Data.Source_Dirs);
+ if In_Tree.Projects.Table
+ (Project).Ada_Sources_Present
+ then
+ Add_To_Source_Path (Data.Source_Dirs, In_Tree);
end if;
end if;
and then
(not Including_Libraries or else not Data.Library))
then
- -- For a library project, add the library directory
+ -- For a library project, add the library ALI
+ -- directory if there is no object directory or
+ -- if the library ALI directory contains ALI files;
+ -- otherwise add the object directory.
if Data.Library then
- Add_To_Object_Path (Data.Library_Dir);
+ if Data.Object_Directory = No_Name
+ or else Contains_ALI_Files (Data.Library_ALI_Dir)
+ then
+ Add_To_Object_Path
+ (Data.Library_ALI_Dir, In_Tree);
+ else
+ Add_To_Object_Path
+ (Data.Object_Directory, In_Tree);
+ end if;
-- For a non-library project, add the object
- -- directory, if it is not a virtual project.
-
- elsif not Data.Virtual then
- Add_To_Object_Path (Data.Object_Directory);
+ -- directory, if it is not a virtual project, and
+ -- if there are Ada sources or if the project is an
+ -- extending project. if There Are No Ada sources,
+ -- adding the object directory could disrupt
+ -- the order of the object dirs in the path.
+
+ elsif not Data.Virtual
+ and then (In_Tree.Projects.Table
+ (Project).Ada_Sources_Present
+ or else
+ (Data.Extends /= No_Project
+ and then
+ Data.Object_Directory /= No_Name))
+ then
+ Add_To_Object_Path
+ (Data.Object_Directory, In_Tree);
end if;
end if;
end if;
-- Call Add for each imported project, if any
while List /= Empty_Project_List loop
- Recursive_Add (Project_Lists.Table (List).Project);
- List := Project_Lists.Table (List).Next;
+ Recursive_Add
+ (In_Tree.Project_Lists.Table
+ (List).Project);
+ List :=
+ In_Tree.Project_Lists.Table (List).Next;
end loop;
end;
end if;
end Recursive_Add;
begin
- Source_Paths.Set_Last (0);
- Object_Paths.Set_Last (0);
+ Source_Path_Table.Set_Last (In_Tree.Private_Part.Source_Paths, 0);
+ Object_Path_Table.Set_Last (In_Tree.Private_Part.Object_Paths, 0);
- for Index in 1 .. Projects.Last loop
- Projects.Table (Index).Seen := False;
+ for Index in Project_Table.First ..
+ Project_Table.Last (In_Tree.Projects)
+ loop
+ In_Tree.Projects.Table (Index).Seen := False;
end loop;
Recursive_Add (Proj);
-- If it is the first time we call this procedure for
-- this project, compute the source path and/or the object path.
- if Projects.Table (Project).Include_Path_File = No_Name then
+ if In_Tree.Projects.Table (Project).Include_Path_File =
+ No_Name
+ then
Process_Source_Dirs := True;
Create_New_Path_File
- (Source_FD, Projects.Table (Project).Include_Path_File);
+ (In_Tree, Source_FD,
+ In_Tree.Projects.Table (Project).Include_Path_File);
end if;
-- For the object path, we make a distinction depending on
-- Including_Libraries.
if Including_Libraries then
- if Projects.Table (Project).Objects_Path_File_With_Libs = No_Name then
+ if In_Tree.Projects.Table
+ (Project).Objects_Path_File_With_Libs = No_Name
+ then
Process_Object_Dirs := True;
Create_New_Path_File
- (Object_FD, Projects.Table (Project).
+ (In_Tree, Object_FD, In_Tree.Projects.Table (Project).
Objects_Path_File_With_Libs);
end if;
else
- if
- Projects.Table (Project).Objects_Path_File_Without_Libs = No_Name
+ if In_Tree.Projects.Table
+ (Project).Objects_Path_File_Without_Libs = No_Name
then
Process_Object_Dirs := True;
Create_New_Path_File
- (Object_FD, Projects.Table (Project).
+ (In_Tree, Object_FD, In_Tree.Projects.Table (Project).
Objects_Path_File_Without_Libs);
end if;
end if;
Add (Project);
end if;
- -- Write and close any file that has been created.
+ -- Write and close any file that has been created
if Source_FD /= Invalid_FD then
- for Index in 1 .. Source_Paths.Last loop
- Get_Name_String (Source_Paths.Table (Index));
+ for Index in Source_Path_Table.First ..
+ Source_Path_Table.Last
+ (In_Tree.Private_Part.Source_Paths)
+ loop
+ Get_Name_String (In_Tree.Private_Part.Source_Paths.Table (Index));
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := ASCII.LF;
Len := Write (Source_FD, Name_Buffer (1)'Address, Name_Len);
end if;
if Object_FD /= Invalid_FD then
- for Index in 1 .. Object_Paths.Last loop
- Get_Name_String (Object_Paths.Table (Index));
+ for Index in Object_Path_Table.First ..
+ Object_Path_Table.Last
+ (In_Tree.Private_Part.Object_Paths)
+ loop
+ Get_Name_String (In_Tree.Private_Part.Object_Paths.Table (Index));
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := ASCII.LF;
Len := Write (Object_FD, Name_Buffer (1)'Address, Name_Len);
-- corresponding flags.
if Current_Source_Path_File /=
- Projects.Table (Project).Include_Path_File
+ In_Tree.Projects.Table (Project).Include_Path_File
then
Current_Source_Path_File :=
- Projects.Table (Project).Include_Path_File;
+ In_Tree.Projects.Table (Project).Include_Path_File;
Set_Path_File_Var
(Project_Include_Path_File,
Get_Name_String (Current_Source_Path_File));
if Including_Libraries then
if Current_Object_Path_File
- /= Projects.Table (Project).Objects_Path_File_With_Libs
+ /= In_Tree.Projects.Table
+ (Project).Objects_Path_File_With_Libs
then
Current_Object_Path_File :=
- Projects.Table (Project).Objects_Path_File_With_Libs;
+ In_Tree.Projects.Table
+ (Project).Objects_Path_File_With_Libs;
Set_Path_File_Var
(Project_Objects_Path_File,
Get_Name_String (Current_Object_Path_File));
end if;
else
- if Current_Object_Path_File
- /= Projects.Table (Project).Objects_Path_File_Without_Libs
+ if Current_Object_Path_File /=
+ In_Tree.Projects.Table
+ (Project).Objects_Path_File_Without_Libs
then
Current_Object_Path_File :=
- Projects.Table (Project).Objects_Path_File_Without_Libs;
+ In_Tree.Projects.Table
+ (Project).Objects_Path_File_Without_Libs;
Set_Path_File_Var
(Project_Objects_Path_File,
Get_Name_String (Current_Object_Path_File));
-- Spec_Path_Name_Of --
-----------------------
- function Spec_Path_Name_Of (Unit : Unit_Id) return String is
- Data : Unit_Data := Units.Table (Unit);
+ function Spec_Path_Name_Of
+ (Unit : Unit_Id; In_Tree : Project_Tree_Ref) return String
+ is
+ Data : Unit_Data := In_Tree.Units.Table (Unit);
begin
if Data.File_Names (Specification).Path = No_Name then
declare
Current_Source : String_List_Id :=
- Projects.Table (Data.File_Names (Specification).Project).Sources;
+ In_Tree.Projects.Table
+ (Data.File_Names (Specification).Project).Sources;
Path : GNAT.OS_Lib.String_Access;
begin
(Namet.Get_Name_String
(Data.File_Names (Specification).Name),
Namet.Get_Name_String
- (String_Elements.Table (Current_Source).Value));
+ (In_Tree.String_Elements.Table
+ (Current_Source).Value));
if Path /= null then
Name_Len := Path'Length;
exit;
else
Current_Source :=
- String_Elements.Table (Current_Source).Next;
+ In_Tree.String_Elements.Table
+ (Current_Source).Next;
end if;
end loop;
- Units.Table (Unit) := Data;
+ In_Tree.Units.Table (Unit) := Data;
end;
end if;
-- Ultimate_Extension_Of --
---------------------------
- function Ultimate_Extension_Of (Project : in Project_Id) return Project_Id
+ function Ultimate_Extension_Of
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref) return Project_Id
is
Result : Project_Id := Project;
begin
- while Projects.Table (Result).Extended_By /= No_Project loop
- Result := Projects.Table (Result).Extended_By;
+ while In_Tree.Projects.Table (Result).Extended_By /=
+ No_Project
+ loop
+ Result := In_Tree.Projects.Table (Result).Extended_By;
end loop;
return Result;
end Ultimate_Extension_Of;
--- Package initialization
--- What is relationshiop to procedure Initialize
-
-begin
- Path_Files.Set_Last (0);
end Prj.Env;
OSDN Git Service
