package body Prj.Env is
- 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 : 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.
-
- Ada_Path_Buffer : String_Access := new String (1 .. 1024);
- -- A buffer where values for ADA_INCLUDE_PATH
- -- and ADA_OBJECTS_PATH are stored.
-
- Ada_Path_Length : Natural := 0;
- -- Index of the last valid character in Ada_Path_Buffer
-
- Ada_Prj_Include_File_Set : Boolean := False;
- Ada_Prj_Objects_File_Set : Boolean := False;
- -- These flags are set to True when the corresponding environment variables
- -- are set and are used to give these environment variables an empty string
- -- value at the end of the program. This has no practical effect on most
- -- platforms, except on VMS where the logical names are deassigned, thus
- -- avoiding the pollution of the environment of the caller.
-
Default_Naming : constant Naming_Id := Naming_Table.First;
- Fill_Mapping_File : Boolean := True;
package Project_Boolean_Htable is new Simple_HTable
(Header_Num => Header_Num,
-- Add to Ada_Path_Buffer all the source directories in string list
-- Source_Dirs, if any. Increment Ada_Path_Length.
- procedure Add_To_Path (Dir : String);
+ procedure Add_To_Path (Dir : String; In_Tree : Project_Tree_Ref);
-- If Dir is not already in the global variable Ada_Path_Buffer, add it.
-- Increment Ada_Path_Length.
-- If Ada_Path_Length /= 0, prepend a Path_Separator character to
if
In_Tree.Projects.Table (Project).Ada_Include_Path = null
then
- Ada_Path_Length := 0;
+ In_Tree.Private_Part.Ada_Path_Length := 0;
for Index in Project_Table.First ..
Project_Table.Last (In_Tree.Projects)
Add (Project);
In_Tree.Projects.Table (Project).Ada_Include_Path :=
- new String'(Ada_Path_Buffer (1 .. Ada_Path_Length));
+ new String'
+ (In_Tree.Private_Part.Ada_Path_Buffer
+ (1 .. In_Tree.Private_Part.Ada_Path_Length));
end if;
return In_Tree.Projects.Table (Project).Ada_Include_Path;
if Recursive then
return Ada_Include_Path (Project, In_Tree).all;
else
- Ada_Path_Length := 0;
+ In_Tree.Private_Part.Ada_Path_Length := 0;
Add_To_Path
(In_Tree.Projects.Table (Project).Source_Dirs, In_Tree);
- return Ada_Path_Buffer (1 .. Ada_Path_Length);
+ return
+ In_Tree.Private_Part.Ada_Path_Buffer
+ (1 .. In_Tree.Private_Part.Ada_Path_Length);
end if;
end Ada_Include_Path;
Contains_ALI_Files (Data.Library_ALI_Dir.Name)
then
Add_To_Path
- (Get_Name_String (Data.Library_ALI_Dir.Name));
+ (Get_Name_String (Data.Library_ALI_Dir.Name),
+ In_Tree);
else
Add_To_Path
- (Get_Name_String (Data.Object_Directory.Name));
+ (Get_Name_String (Data.Object_Directory.Name),
+ In_Tree);
end if;
else
-- For a non library project, add the object directory
Add_To_Path
- (Get_Name_String (Data.Object_Directory.Name));
+ (Get_Name_String (Data.Object_Directory.Name),
+ In_Tree);
end if;
end if;
if
In_Tree.Projects.Table (Project).Ada_Objects_Path = null
then
- Ada_Path_Length := 0;
+ In_Tree.Private_Part.Ada_Path_Length := 0;
for Index in Project_Table.First ..
Project_Table.Last (In_Tree.Projects)
Add (Project);
In_Tree.Projects.Table (Project).Ada_Objects_Path :=
- new String'(Ada_Path_Buffer (1 .. Ada_Path_Length));
+ new String'
+ (In_Tree.Private_Part.Ada_Path_Buffer
+ (1 .. In_Tree.Private_Part.Ada_Path_Length));
end if;
return In_Tree.Projects.Table (Project).Ada_Objects_Path;
begin
while Current /= Nil_String loop
Source_Dir := In_Tree.String_Elements.Table (Current);
- Add_To_Path (Get_Name_String (Source_Dir.Display_Value));
+ Add_To_Path (Get_Name_String (Source_Dir.Display_Value), In_Tree);
Current := Source_Dir.Next;
end loop;
end Add_To_Path;
- procedure Add_To_Path (Dir : String) is
+ procedure Add_To_Path (Dir : String; In_Tree : Project_Tree_Ref) is
Len : Natural;
New_Buffer : String_Access;
Min_Len : Natural;
-- Start of processing for Add_To_Path
begin
- if Is_Present (Ada_Path_Buffer (1 .. Ada_Path_Length), Dir) then
+ if Is_Present (In_Tree.Private_Part.Ada_Path_Buffer
+ (1 .. In_Tree.Private_Part.Ada_Path_Length),
+ Dir)
+ then
-- Dir is already in the path, nothing to do
return;
end if;
- Min_Len := Ada_Path_Length + Dir'Length;
+ Min_Len := In_Tree.Private_Part.Ada_Path_Length + Dir'Length;
- if Ada_Path_Length > 0 then
+ if In_Tree.Private_Part.Ada_Path_Length > 0 then
-- Add 1 for the Path_Separator character
-- If Ada_Path_Buffer is too small, increase it
- Len := Ada_Path_Buffer'Last;
+ Len := In_Tree.Private_Part.Ada_Path_Buffer'Last;
if Len < Min_Len then
loop
end loop;
New_Buffer := new String (1 .. Len);
- New_Buffer (1 .. Ada_Path_Length) :=
- Ada_Path_Buffer (1 .. Ada_Path_Length);
- Free (Ada_Path_Buffer);
- Ada_Path_Buffer := New_Buffer;
+ New_Buffer (1 .. In_Tree.Private_Part.Ada_Path_Length) :=
+ In_Tree.Private_Part.Ada_Path_Buffer
+ (1 .. In_Tree.Private_Part.Ada_Path_Length);
+ Free (In_Tree.Private_Part.Ada_Path_Buffer);
+ In_Tree.Private_Part.Ada_Path_Buffer := New_Buffer;
end if;
- if Ada_Path_Length > 0 then
- Ada_Path_Length := Ada_Path_Length + 1;
- Ada_Path_Buffer (Ada_Path_Length) := Path_Separator;
+ if In_Tree.Private_Part.Ada_Path_Length > 0 then
+ In_Tree.Private_Part.Ada_Path_Length :=
+ In_Tree.Private_Part.Ada_Path_Length + 1;
+ In_Tree.Private_Part.Ada_Path_Buffer
+ (In_Tree.Private_Part.Ada_Path_Length) := Path_Separator;
end if;
- Ada_Path_Buffer
- (Ada_Path_Length + 1 .. Ada_Path_Length + Dir'Length) := Dir;
- Ada_Path_Length := Ada_Path_Length + Dir'Length;
+ In_Tree.Private_Part.Ada_Path_Buffer
+ (In_Tree.Private_Part.Ada_Path_Length + 1 ..
+ In_Tree.Private_Part.Ada_Path_Length + Dir'Length) := Dir;
+ In_Tree.Private_Part.Ada_Path_Length :=
+ In_Tree.Private_Part.Ada_Path_Length + Dir'Length;
end Add_To_Path;
------------------------
end if;
if Language = No_Name then
- if Fill_Mapping_File then
+ if In_Tree.Private_Part.Fill_Mapping_File then
for Unit in 1 .. Unit_Table.Last (In_Tree.Units) loop
The_Unit_Data := In_Tree.Units.Table (Unit);
exit when Source = No_Source;
if Source.Language.Name = Language
- and then not Source.Locally_Removed
- and then Source.Replaced_By = No_Source
- and then Source.Path.Name /= No_Path
+ and then not Source.Locally_Removed
+ and then Source.Replaced_By = No_Source
+ and then Source.Path.Name /= No_Path
then
if Source.Unit /= No_Name then
Get_Name_String (Source.Unit);
GNAT.OS_Lib.Close (File, Status);
if not Status then
- Prj.Com.Fail ("disk full, could not write mapping file");
+
-- We were able to create the temporary file, so there is no problem
-- of protection. However, we are not able to close it, so there must
-- be a capacity problem that we express using "disk full".
+
+ Prj.Com.Fail ("disk full, could not write mapping file");
end if;
end Create_Mapping_File;
-- the empty string. On VMS, this has the effect of deassigning
-- the logical names.
- if Ada_Prj_Include_File_Set then
+ if In_Tree.Private_Part.Ada_Prj_Include_File_Set then
Setenv (Project_Include_Path_File, "");
- Ada_Prj_Include_File_Set := False;
+ In_Tree.Private_Part.Ada_Prj_Include_File_Set := False;
end if;
- if Ada_Prj_Objects_File_Set then
+ if In_Tree.Private_Part.Ada_Prj_Objects_File_Set then
Setenv (Project_Objects_Path_File, "");
- Ada_Prj_Objects_File_Set := False;
+ In_Tree.Private_Part.Ada_Prj_Objects_File_Set := False;
end if;
end Delete_All_Path_Files;
procedure Recurse (Prj : Project_Id) is
Data : Project_Data renames In_Tree.Projects.Table (Prj);
List : Project_List := Data.Imported_Projects;
+
begin
if not Get (Seen, Prj) then
Set (Seen, Prj, True);
end if;
end Recurse;
+ -- Start of processing for For_All_Imported_Projects
+
begin
Recurse (Project);
Reset (Seen);
end For_Project;
procedure Get_Object_Dirs is new For_All_Imported_Projects (For_Project);
+
+ -- Start of processing for For_All_Object_Dirs
+
begin
Get_Object_Dirs (Project, In_Tree);
end For_All_Object_Dirs;
Data : Project_Data renames In_Tree.Projects.Table (Prj);
Current : String_List_Id := Data.Source_Dirs;
The_String : String_Element;
+
begin
-- If there are Ada sources, call action with the name of every
-- source directory.
end For_Project;
procedure Get_Source_Dirs is new For_All_Imported_Projects (For_Project);
+
+ -- Start of processing for For_All_Source_Dirs
+
begin
Get_Source_Dirs (Project, In_Tree);
end For_All_Source_Dirs;
-- Initialize --
----------------
- procedure Initialize is
+ procedure Initialize (In_Tree : Project_Tree_Ref) is
begin
- Fill_Mapping_File := True;
- Current_Source_Path_File := No_Path;
- Current_Object_Path_File := No_Path;
+ In_Tree.Private_Part.Fill_Mapping_File := True;
+ In_Tree.Private_Part.Current_Source_Path_File := No_Path;
+ In_Tree.Private_Part.Current_Object_Path_File := No_Path;
end Initialize;
-------------------
-- Set the env vars, if they need to be changed, and set the
-- corresponding flags.
- if Current_Source_Path_File /=
+ if In_Tree.Private_Part.Current_Source_Path_File /=
In_Tree.Projects.Table (Project).Include_Path_File
then
- Current_Source_Path_File :=
+ In_Tree.Private_Part.Current_Source_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));
- Ada_Prj_Include_File_Set := True;
+ Get_Name_String (In_Tree.Private_Part.Current_Source_Path_File));
+ In_Tree.Private_Part.Ada_Prj_Include_File_Set := True;
end if;
if Including_Libraries then
- if Current_Object_Path_File
- /= In_Tree.Projects.Table
- (Project).Objects_Path_File_With_Libs
+ if In_Tree.Private_Part.Current_Object_Path_File /=
+ In_Tree.Projects.Table (Project).Objects_Path_File_With_Libs
then
- Current_Object_Path_File :=
+ In_Tree.Private_Part.Current_Object_Path_File :=
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));
- Ada_Prj_Objects_File_Set := True;
+ Get_Name_String
+ (In_Tree.Private_Part.Current_Object_Path_File));
+ In_Tree.Private_Part.Ada_Prj_Objects_File_Set := True;
end if;
else
- if Current_Object_Path_File /=
- In_Tree.Projects.Table
- (Project).Objects_Path_File_Without_Libs
+ if In_Tree.Private_Part.Current_Object_Path_File /=
+ In_Tree.Projects.Table (Project).Objects_Path_File_Without_Libs
then
- Current_Object_Path_File :=
+ In_Tree.Private_Part.Current_Object_Path_File :=
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));
- Ada_Prj_Objects_File_Set := True;
+ Get_Name_String
+ (In_Tree.Private_Part.Current_Object_Path_File));
+ In_Tree.Private_Part.Ada_Prj_Objects_File_Set := True;
end if;
end if;
end Set_Ada_Paths;
-- Set_Mapping_File_Initial_State_To_Empty --
---------------------------------------------
- procedure Set_Mapping_File_Initial_State_To_Empty is
+ procedure Set_Mapping_File_Initial_State_To_Empty
+ (In_Tree : Project_Tree_Ref)
+ is
begin
- Fill_Mapping_File := False;
+ In_Tree.Private_Part.Fill_Mapping_File := False;
end Set_Mapping_File_Initial_State_To_Empty;
-----------------------
procedure Set_Path_File_Var (Name : String; Value : String) is
Host_Spec : String_Access := To_Host_File_Spec (Value);
-
begin
if Host_Spec = null then
Prj.Com.Fail
Result : Project_Id := Project;
begin
- while In_Tree.Projects.Table (Result).Extended_By /=
- No_Project
- loop
+ while In_Tree.Projects.Table (Result).Extended_By /= No_Project loop
Result := In_Tree.Projects.Table (Result).Extended_By;
end loop;
Spec_Suffix : File_Name_Type;
Casing : Casing_Type;
Kind : out Source_Kind;
- Unit : out Name_Id);
+ Unit : out Name_Id;
+ In_Tree : Project_Tree_Ref);
-- Check whether the file matches the naming scheme. If it does,
-- compute its unit name. If Unit is set to No_Name on exit, none of the
-- other out parameters are relevant.
Id.Project := Project;
Id.Language := Lang_Id;
Id.Lang_Kind := Lang_Kind;
- Id.Compiled :=
- Lang_Id.Config.Compiler_Driver /= Empty_File_Name;
+ Id.Compiled := Lang_Id.Config.Compiler_Driver /=
+ Empty_File_Name;
Id.Kind := Kind;
Id.Alternate_Languages := Alternate_Languages;
Id.Other_Part := Other_Part;
- Id.Object_Exists := Config.Object_Generated;
- Id.Object_Linked := Config.Objects_Linked;
+ Id.Object_Exists := Config.Object_Generated;
+ Id.Object_Linked := Config.Objects_Linked;
if Other_Part /= No_Source then
Other_Part.Other_Part := Id;
begin
Language := Data.Languages;
while Language /= No_Language_Index loop
+
-- If there are no sources for this language, check whether
-- there are sources for which this is an alternate
- -- language
+ -- language.
if Language.First_Source = No_Source then
Iter := For_Each_Source (In_Tree => In_Tree,
Data.Decl.Attributes,
In_Tree);
- List : String_List_Id;
- Element : String_Element;
- Name : File_Name_Type;
- Iter : Source_Iterator;
- Source : Source_Id;
+ List : String_List_Id;
+ Element : String_Element;
+ Name : File_Name_Type;
+ Iter : Source_Iterator;
+ Source : Source_Id;
Project_2 : Project_Id;
begin
-----------------------------------
procedure Process_Exceptions_File_Based
- (Lang_Id : Language_Ptr;
- Kind : Source_Kind)
+ (Lang_Id : Language_Ptr;
+ Kind : Source_Kind)
is
Lang : constant Name_Id := Lang_Id.Name;
Exceptions : Array_Element_Id;
-----------------------------------
procedure Process_Exceptions_Unit_Based
- (Lang_Id : Language_Ptr;
- Kind : Source_Kind)
+ (Lang_Id : Language_Ptr;
+ Kind : Source_Kind)
is
Lang : constant Name_Id := Lang_Id.Name;
Exceptions : Array_Element_Id;
Spec_Suffix : File_Name_Type;
Casing : Casing_Type;
Kind : out Source_Kind;
- Unit : out Name_Id)
+ Unit : out Name_Id;
+ In_Tree : Project_Tree_Ref)
is
Filename : constant String := Get_Name_String (File_Name);
Last : Integer := Filename'Last;
-- If it is potentially a run time source, disable filling
-- of the mapping file to avoid warnings.
- Set_Mapping_File_Initial_State_To_Empty;
+ Set_Mapping_File_Initial_State_To_Empty (In_Tree);
end if;
end if;
end;
Spec_Suffix => Spec_Suffix_Id_Of (In_Tree, Name_Ada, Naming),
Casing => Naming.Casing,
Kind => Kind,
- Unit => Unit_Name);
+ Unit => Unit_Name,
+ In_Tree => In_Tree);
case Kind is
when Spec => Unit_Kind := Specification;
Spec_Suffix => Config.Naming_Data.Spec_Suffix,
Casing => Config.Naming_Data.Casing,
Kind => Kind,
- Unit => Unit);
+ Unit => Unit,
+ In_Tree => In_Tree);
if Unit /= No_Name then
Language := Tmp_Lang;
with Debug;
with Osint; use Osint;
with Prj.Attr;
-with Prj.Env;
with Prj.Err; use Prj.Err;
with Snames; use Snames;
with Table;
procedure Language_Changed (Iter : in out Source_Iterator) is
begin
Iter.Current := No_Source;
+
if Iter.Language_Name /= No_Name then
while Iter.Language /= null
and then Iter.Language.Name /= Iter.Language_Name
if Iter.Language = No_Language_Index then
if Iter.All_Projects then
Iter.Project := Iter.Project + 1;
+
if Iter.Project > Project_Table.Last (Iter.In_Tree.Projects) then
Iter.Project := No_Project;
else
Project_Changed (Iter);
end if;
+
else
Iter.Project := No_Project;
end if;
+
else
Iter.Current := Iter.Language.First_Source;
+
if Iter.Current = No_Source then
Iter.Language := Iter.Language.Next;
Language_Changed (Iter);
Name_Buffer (1) := '/';
Slash_Id := Name_Find;
- Prj.Env.Initialize;
Prj.Attr.Initialize;
Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project));
Set_Name_Table_Byte (Name_Extends, Token_Type'Pos (Tok_Extends));
(Data : Project_Data;
Language_Name : Name_Id) return Boolean
is
- Lang_Ind : Language_Ptr := Data.Languages;
+ Lang_Ind : Language_Ptr;
+
begin
+ Lang_Ind := Data.Languages;
while Lang_Ind /= No_Language_Index loop
if Lang_Ind.Name = Language_Name then
return True;
function Object_Name
(Source_File_Name : File_Name_Type;
- Object_File_Suffix : Name_Id := No_Name)
- return File_Name_Type
+ Object_File_Suffix : Name_Id := No_Name) return File_Name_Type
is
begin
if Object_File_Suffix = No_Name then
Default_Body_Suffix : File_Name_Type;
In_Tree : Project_Tree_Ref)
is
- Lang : Name_Id;
- Suffix : Array_Element_Id;
- Found : Boolean := False;
+ Lang : Name_Id;
+ Suffix : Array_Element_Id;
+ Found : Boolean := False;
Element : Array_Element;
begin
procedure Free (Tree : in out Project_Tree_Ref) is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Project_Tree_Data, Project_Tree_Ref);
+
begin
if Tree /= null then
Name_List_Table.Free (Tree.Name_Lists);
procedure Reset (Tree : Project_Tree_Ref) is
begin
- Prj.Env.Initialize;
-
-- Visible tables
Name_List_Table.Init (Tree.Name_Lists);
In_Tree => Tree);
Tree.Private_Part.Default_Naming.Separate_Suffix :=
Default_Ada_Body_Suffix;
+
+ Tree.Private_Part.Current_Source_Path_File := No_Path;
+ Tree.Private_Part.Current_Object_Path_File := No_Path;
+ Tree.Private_Part.Ada_Path_Length := 0;
+ Tree.Private_Part.Ada_Prj_Include_File_Set := False;
+ Tree.Private_Part.Ada_Prj_Objects_File_Set := False;
+ Tree.Private_Part.Fill_Mapping_File := True;
end if;
end Reset;
OSDN Git Service
