-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2007, 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- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- 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. --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-with Namet; use Namet;
with Opt;
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_Source_Path_File : Path_Name_Type := No_Path;
-- Current value of project source path file env var.
-- Used to avoid setting the env var to the same value.
- Current_Object_Path_File : Name_Id := No_Name;
+ Current_Object_Path_File : Path_Name_Type := No_Path;
-- Current value of project object 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_Index;
+ 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_Index;
+ 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 : Path_Name_Type;
+ 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.
- procedure Create_New_Path_File
- (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
- -- Temp_Path_File_Name by 1.
+ function Contains_ALI_Files (Dir : Path_Name_Type) return Boolean;
+ -- Return True if there is at least one ALI file in the directory Dir
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
if (Data.Library and then Including_Libraries)
or else
- (Data.Object_Directory /= No_Name
+ (Data.Object_Directory /= No_Path
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_Path
+ 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 : Path_Name_Type; 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_Index;
+ 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,
-- we compute it, and we store it.
- if Data.File_Names (Body_Part).Path = No_Name then
+ if Data.File_Names (Body_Part).Path = No_Path 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).Ada_Sources;
Path : GNAT.OS_Lib.String_Access;
begin
-- By default, put the file name
Data.File_Names (Body_Part).Path :=
- Data.File_Names (Body_Part).Name;
+ Path_Name_Type (Data.File_Names (Body_Part).Name);
-- For each source directory
(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 : Path_Name_Type) 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);
pragma Unreferenced (Include_Config_Files);
- File_Name : Name_Id := No_Name;
+ File_Name : Path_Name_Type := No_Path;
File : File_Descriptor := Invalid_FD;
- Current_Unit : Unit_Id := Units.First;
+ Current_Unit : Unit_Index := Unit_Table.First;
First_Project : Project_List := Empty_Project_List;
procedure Put
(Unit_Name : Name_Id;
- File_Name : Name_Id;
- Unit_Kind : Spec_Or_Body);
+ File_Name : File_Name_Type;
+ Unit_Kind : Spec_Or_Body;
+ Index : Int);
-- Put an SFN pragma in the temporary file
procedure Put (File : File_Descriptor; S : String);
-----------
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) &
+ Spec_Suffix_Of (In_Tree, "ada", Data.Naming) &
""",");
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) &
+ Body_Suffix_Of (In_Tree, "ada", Data.Naming) &
""",");
Put_Line
(File, " Casing => " &
-- and maybe separate
- if
- Data.Naming.Current_Body_Suffix /= Data.Naming.Separate_Suffix
+ if Body_Suffix_Of (In_Tree, "ada", Data.Naming) /=
+ Get_Name_String (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;
if File = Invalid_FD then
Prj.Com.Fail
("unable to create temporary configuration pragmas file");
- elsif Opt.Verbose_Mode then
- Write_Str ("Creating temp file """);
- Write_Str (Get_Name_String (File_Name));
- Write_Line ("""");
+
+ else
+ Record_Temp_File (File_Name);
+
+ if Opt.Verbose_Mode then
+ Write_Str ("Creating temp file """);
+ Write_Str (Get_Name_String (File_Name));
+ Write_Line ("""");
+ end if;
end if;
end if;
end Check_Temp_File;
procedure Put
(Unit_Name : Name_Id;
- File_Name : Name_Id;
- Unit_Kind : Spec_Or_Body)
+ File_Name : File_Name_Type;
+ Unit_Kind : Spec_Or_Body;
+ Index : Int)
is
begin
-- A temporary file needs to be open
end if;
Put (File, Namet.Get_Name_String (File_Name));
- Put_Line (File, """);");
+ Put (File, """");
+
+ if Index /= 0 then
+ Put (File, ", Index =>");
+ Put (File, Index'Img);
+ end if;
+
+ Put_Line (File, ");");
end Put;
procedure Put (File : File_Descriptor; S : String) is
Last : Natural;
begin
- -- Add an ASCII.LF to the string. As this gnat.adc is supposed to
+ -- Add an ASCII.LF to the string. As this config file is supposed to
-- be used only by the compiler, we don't care about the characters
-- for the end of line. In fact we could have put a space, but
-- it is more convenient to be able to read gnat.adc during
-- 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
Put (Unit.Name,
Unit.File_Names (Specification).Name,
- Specification);
+ Specification,
+ Unit.File_Names (Specification).Index);
end if;
if Unit.File_Names (Body_Part).Needs_Pragma then
Put (Unit.Name,
Unit.File_Names (Body_Part).Name,
- Body_Part);
+ Body_Part,
+ Unit.File_Names (Body_Part).Index);
end if;
Current_Unit := Current_Unit + 1;
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;
- Name : out Name_Id)
+ In_Tree : Project_Tree_Ref;
+ Name : out Path_Name_Type)
is
File : File_Descriptor := Invalid_FD;
The_Unit_Data : Unit_Data;
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
if File = Invalid_FD then
Prj.Com.Fail ("unable to create temporary mapping file");
- elsif Opt.Verbose_Mode then
- Write_Str ("Creating temp mapping file """);
- Write_Str (Get_Name_String (Name));
- Write_Line ("""");
+ 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 .. 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
-- 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_Name and then Present (Data.Project) then
+ if Data.Name /= No_File and then Present (Data.Project) then
Put_Data (Spec => True);
end if;
-- 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_Name and then Present (Data.Project) then
+ if Data.Name /= No_File and then Present (Data.Project) then
Put_Data (Spec => False);
end if;
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 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;
+
+ -- 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 Src_Data.Language_Name = Language and then
+ (not Src_Data.Locally_Removed) and then
+ Src_Data.Replaced_By = No_Source
+ 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;
+
+ Get_Name_String (Src_Data.File);
+ Put_Name_Buffer;
+
+ Get_Name_String (Src_Data.Path);
+ Put_Name_Buffer;
+ end if;
+
+ Source := Src_Data.Next_In_Project;
+ end loop;
+ end if;
+ end loop;
+
+ GNAT.OS_Lib.Close (File, Status);
+
+ if not Status then
+ Prj.Com.Fail ("disk full");
+ end if;
+ end Create_Mapping_File;
+
--------------------------
-- Create_New_Path_File --
--------------------------
procedure Create_New_Path_File
- (Path_FD : out File_Descriptor;
- Path_Name : out Name_Id)
+ (In_Tree : Project_Tree_Ref;
+ Path_FD : out File_Descriptor;
+ Path_Name : out Path_Name_Type)
is
begin
Tempdir.Create_Temp_File (Path_FD, Path_Name);
- if Path_Name /= No_Name then
+ if Path_Name /= No_Path then
+ Record_Temp_File (Path_Name);
- -- Record the name, so that the temp path file will be deleted
- -- at the end of the program.
+ -- 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_Path 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);
+ Name &
+ Spec_Suffix_Of (In_Tree, "ada", Data.Naming);
Extended_Body_Name : String :=
- Name & Namet.Get_Name_String
- (Data.Naming.Current_Body_Suffix);
+ Name &
+ Body_Suffix_Of (In_Tree, "ada", Data.Naming);
Unit : Unit_Data;
Write_Eol;
end if;
- -- For extending project, search in the extended project
- -- if the source is not found. For non extending projects,
- -- this loop will be run only once.
+ -- For extending project, search in the extended project if the source
+ -- is not found. For non extending projects, this loop will be run only
+ -- once.
loop
-- 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
or else Unit.File_Names (Body_Part).Project = The_Project
then
declare
- Current_Name : constant Name_Id :=
+ Current_Name : constant File_Name_Type :=
Unit.File_Names (Body_Part).Name;
begin
-- Case of a body present
- if Current_Name /= No_Name then
+ if Current_Name /= No_File then
if Current_Verbosity = High then
Write_Str (" Comparing with """);
Write_Str (Get_Name_String (Current_Name));
Write_Eol;
end if;
- -- If it has the name of the original name,
- -- return the original name
+ -- If it has the name of the original name, return the
+ -- original name.
if Unit.Name = The_Original_Name
- or else Current_Name = The_Original_Name
+ or else
+ Current_Name = File_Name_Type (The_Original_Name)
then
if Current_Verbosity = High then
Write_Line (" OK");
-- If it has the name of the extended body name,
-- return the extended body name
- elsif Current_Name = The_Body_Name then
+ elsif Current_Name = File_Name_Type (The_Body_Name) then
if Current_Verbosity = High then
Write_Line (" OK");
end if;
or else Unit.File_Names (Specification).Project = The_Project
then
declare
- Current_Name : constant Name_Id :=
+ Current_Name : constant File_Name_Type :=
Unit.File_Names (Specification).Name;
begin
-- Case of spec present
- if Current_Name /= No_Name then
+ if Current_Name /= No_File then
if Current_Verbosity = High then
Write_Str (" Comparing with """);
Write_Str (Get_Name_String (Current_Name));
-- If name same as original name, return original name
if Unit.Name = The_Original_Name
- or else Current_Name = The_Original_Name
+ or else
+ Current_Name = File_Name_Type (The_Original_Name)
then
if Current_Verbosity = High then
Write_Line (" OK");
end if;
-
if Full_Path then
return Get_Name_String
(Unit.File_Names (Specification).Path);
-- If it has the same name as the extended spec name,
-- return the extended spec name.
- elsif Current_Name = The_Spec_Name then
+ elsif Current_Name = File_Name_Type (The_Spec_Name) then
if Current_Verbosity = High then
Write_Line (" OK");
end if;
-- 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);
- -- Process a project. Remember the processes visited to avoid
- -- processing a project twice. Recursively process an eventual
- -- extended project, and all imported projects.
+ -- Process a project. Remember the processes visited to avoid processing
+ -- a project twice. Recursively process an eventual extended project,
+ -- and all imported projects.
---------
-- Add --
---------
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 is an object directory, call Action
- -- with its name
+ -- If there is an object directory, call Action with its name
- if Data.Object_Directory /= No_Name then
- Get_Name_String (Data.Object_Directory);
+ if Data.Object_Directory /= No_Path then
+ Get_Name_String (Data.Display_Object_Dir);
Action (Name_Buffer (1 .. Name_Len));
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;
-- Start of processing for For_All_Object_Dirs
begin
- -- Visit this project, and its imported projects,
- -- recursively
+ -- Visit this project, and its imported projects, recursively
Add (Project);
end For_All_Object_Dirs;
-- 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);
- -- Process a project. Remember the processes visited to avoid
- -- processing a project twice. Recursively process an eventual
- -- extended project, and all imported projects.
+ -- Process a project. Remember the processes visited to avoid processing
+ -- a project twice. Recursively process an eventual extended project,
+ -- and all imported projects.
---------
-- Add --
---------
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
- -- If the list of visited project is empty, then
- -- for sure we never visited this project.
+ -- If the list of visited project is empty, then 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.
+ -- 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).Sources_Present then
+ if
+ In_Tree.Projects.Table (Project).Ada_Sources /= Nil_String
+ then
while Current /= Nil_String loop
- The_String := String_Elements.Table (Current);
- Action (Get_Name_String (The_String.Value));
+ The_String :=
+ In_Tree.String_Elements.Table (Current);
+ Action (Get_Name_String (The_String.Display_Value));
Current := The_String.Next;
end loop;
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;
procedure Get_Reference
(Source_File_Name : String;
+ In_Tree : Project_Tree_Ref;
Project : out Project_Id;
- Path : out Name_Id)
+ Path : out Path_Name_Type)
is
begin
-- Body below could use some comments ???
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
+ if (Unit.File_Names (Specification).Name /= No_File
and then
Namet.Get_Name_String
(Unit.File_Names (Specification).Name) = Original_Name)
- or else (Unit.File_Names (Specification).Path /= No_Name
+ or else (Unit.File_Names (Specification).Path /= No_Path
and then
Namet.Get_Name_String
(Unit.File_Names (Specification).Path) =
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
return;
- elsif (Unit.File_Names (Body_Part).Name /= No_Name
+ elsif (Unit.File_Names (Body_Part).Name /= No_File
and then
Namet.Get_Name_String
(Unit.File_Names (Body_Part).Name) = Original_Name)
- or else (Unit.File_Names (Body_Part).Path /= No_Name
+ or else (Unit.File_Names (Body_Part).Path /= No_Path
and then Namet.Get_Name_String
(Unit.File_Names (Body_Part).Path) =
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
end;
Project := No_Project;
- Path := No_Name;
+ Path := No_Path;
if Current_Verbosity > Default then
Write_Str ("Cannot be found.");
-- 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);
+ Name &
+ Spec_Suffix_Of (In_Tree, "ada", Data.Naming);
Extended_Body_Name : String :=
- Name & Namet.Get_Name_String
- (Data.Naming.Current_Body_Suffix);
+ Name &
+ Body_Suffix_Of (In_Tree, "ada", Data.Naming);
- First : Unit_Id := Units.First;
- Current : Unit_Id;
+ First : Unit_Index := Unit_Table.First;
+ Current : Unit_Index;
Unit : Unit_Data;
begin
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
+ and then Unit.File_Names (Body_Part).Name /= No_File
then
declare
Current_Name : constant String :=
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
end if;
end;
- elsif Unit.File_Names (Specification).Name /= No_Name then
+ elsif Unit.File_Names (Specification).Name /= No_File then
declare
Current_Name : constant String :=
Namet.Get_Name_String
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));
- if Unit.File_Names (Specification).Name /= No_Name then
+ if Unit.File_Names (Specification).Name /= No_File then
if Unit.File_Names (Specification).Project = No_Project then
Write_Line (" No project");
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;
(Unit.File_Names (Specification).Name));
end if;
- if Unit.File_Names (Body_Part).Name /= No_Name then
+ if Unit.File_Names (Body_Part).Name /= No_File then
if Unit.File_Names (Body_Part).Project = No_Project then
Write_Line (" No project");
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);
+ Name &
+ Spec_Suffix_Of (In_Tree, "ada", Data.Naming);
Extended_Body_Name : String :=
- Name & Namet.Get_Name_String
- (Data.Naming.Current_Body_Suffix);
+ Name &
+ Body_Suffix_Of (In_Tree, "ada", Data.Naming);
Unit : Unit_Data;
- Current_Name : Name_Id;
-
- The_Original_Name : Name_Id;
- The_Spec_Name : Name_Id;
- The_Body_Name : Name_Id;
+ Current_Name : File_Name_Type;
+ The_Original_Name : File_Name_Type;
+ The_Spec_Name : File_Name_Type;
+ The_Body_Name : File_Name_Type;
begin
Canonical_Case_File_Name (Original_Name);
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
-- Case of a body present
- if Current_Name /= No_Name then
+ if Current_Name /= No_File then
-- If it has the name of the original name or the body name,
-- we have found the project.
- if Unit.Name = The_Original_Name
+ if Unit.Name = Name_Id (The_Original_Name)
or else Current_Name = The_Original_Name
or else Current_Name = The_Body_Name
then
Current_Name := Unit.File_Names (Specification).Name;
- if Current_Name /= No_Name then
+ if Current_Name /= No_File then
-- If name same as the original name, or the spec name, we have
-- found the project.
- if Unit.Name = The_Original_Name
+ if Unit.Name = Name_Id (The_Original_Name)
or else Current_Name = The_Original_Name
or else Current_Name = The_Spec_Name
then
-- 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
if Process_Source_Dirs then
- -- Add to path all source directories of this project
- -- if there are Ada sources.
+ -- Add to path all source directories of this project if
+ -- there are Ada sources.
- if Projects.Table (Project).Sources_Present then
- Add_To_Source_Path (Data.Source_Dirs);
+ if In_Tree.Projects.Table (Project).Ada_Sources /=
+ Nil_String
+ then
+ Add_To_Source_Path (Data.Source_Dirs, In_Tree);
end if;
end if;
if Process_Object_Dirs then
-- Add to path the object directory of this project
- -- except if we don't include library project and
- -- this is a library project.
+ -- except if we don't include library project and this
+ -- is a library project.
if (Data.Library and then Including_Libraries)
or else
- (Data.Object_Directory /= No_Name
+ (Data.Object_Directory /= No_Path
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);
-
- else
- -- For a non library project, add the object
- -- directory.
-
- Add_To_Object_Path (Data.Object_Directory);
+ if Data.Object_Directory = No_Path
+ 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, 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 There_Are_Ada_Sources (In_Tree, Project)
+ 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_Path 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_Path
+ 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_Path
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_Index; 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
+ if Data.File_Names (Specification).Path = No_Path then
declare
Current_Source : String_List_Id :=
- Projects.Table (Data.File_Names (Specification).Project).Sources;
+ In_Tree.Projects.Table
+ (Data.File_Names (Specification).Project).Ada_Sources;
Path : GNAT.OS_Lib.String_Access;
begin
Data.File_Names (Specification).Path :=
- Data.File_Names (Specification).Name;
+ Path_Name_Type (Data.File_Names (Specification).Name);
while Current_Source /= Nil_String loop
Path := Locate_Regular_File
(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
