Commit 481f29eb by Vincent Celier Committed by Arnaud Charlet

gnatcmd.adb: Call Prj.Env.Initialize with the Project_Tree

2009-04-24  Vincent Celier  <celier@adacore.com>

	* gnatcmd.adb: Call Prj.Env.Initialize with the Project_Tree

	* prj-env.adb: Move all global variables to the private part of the
	project tree data.
	Access these new components instead of the global variables no longer
	in existence.
	(Add_To_Path): New Project_Tree_Ref parameter, to access the new
	components that were previously global variables.

	* prj-env.ads (Initialize): New Project_Tree_Ref parameter
	(Set_Mapping_File_Initial_State_To_Empty): New Project_Tree_Ref
	parameter.

	* prj-nmsc.adb (Compute_Unit_Name): New Project_Tree_Ref parameter to
	be able to call Set_Mapping_File_Initial_State_To_Empty with it.

	* prj.adb (Initialize): Do not call Prj.Env.Initialize
	(Reset): Do not call Prj.Env.Initialize. Instead, initialize the new
	components in the private part of the project tree data.

	* prj.ads (Private_Project_Tree_Data): new components moved from
	Prj.Env: Current_Source_Path_File, Current_Object_Path_File,
	Ada_Path_Buffer, Ada_Path_Length, Ada_Prj_Include_File_Set,
	Ada_Prj_Objects_File_Set, Fill_Mapping_File.

From-SVN: r146696
parent 30349c74
2009-04-24 Vincent Celier <celier@adacore.com>
* gnatcmd.adb: Call Prj.Env.Initialize with the Project_Tree
* prj-env.adb: Move all global variables to the private part of the
project tree data.
Access these new components instead of the global variables no longer
in existence.
(Add_To_Path): New Project_Tree_Ref parameter, to access the new
components that were previously global variables.
* prj-env.ads (Initialize): New Project_Tree_Ref parameter
(Set_Mapping_File_Initial_State_To_Empty): New Project_Tree_Ref
parameter.
* prj-nmsc.adb (Compute_Unit_Name): New Project_Tree_Ref parameter to
be able to call Set_Mapping_File_Initial_State_To_Empty with it.
* prj.adb (Initialize): Do not call Prj.Env.Initialize
(Reset): Do not call Prj.Env.Initialize. Instead, initialize the new
components in the private part of the project tree data.
* prj.ads (Private_Project_Tree_Data): new components moved from
Prj.Env: Current_Source_Path_File, Current_Object_Path_File,
Ada_Path_Buffer, Ada_Path_Length, Ada_Prj_Include_File_Set,
Ada_Prj_Objects_File_Set, Fill_Mapping_File.
2009-04-24 Vincent Celier <celier@adacore.com>
* opt.ads (Unchecked_Shared_Lib_Imports): New Boolean flag.
* prj-nmsc.adb (Check_Library): No error for imports by shared library
......
......@@ -2411,7 +2411,7 @@ begin
-- First make sure that the recorded file names are empty
Prj.Env.Initialize;
Prj.Env.Initialize (Project_Tree);
Prj.Env.Set_Ada_Paths
(Project, Project_Tree, Including_Libraries => False);
......
......@@ -34,31 +34,7 @@ with GNAT.Directory_Operations; use GNAT.Directory_Operations;
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,
......@@ -80,7 +56,7 @@ package body Prj.Env is
-- 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
......@@ -170,7 +146,7 @@ package body Prj.Env is
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)
......@@ -180,7 +156,9 @@ package body Prj.Env is
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;
......@@ -199,10 +177,12 @@ package body Prj.Env is
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;
......@@ -258,17 +238,20 @@ package body Prj.Env is
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;
......@@ -299,7 +282,7 @@ package body Prj.Env is
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)
......@@ -309,7 +292,9 @@ package body Prj.Env is
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;
......@@ -368,12 +353,12 @@ package body Prj.Env is
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;
......@@ -411,16 +396,19 @@ package body Prj.Env is
-- 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
......@@ -429,7 +417,7 @@ package body Prj.Env is
-- 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
......@@ -438,20 +426,25 @@ package body Prj.Env is
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;
------------------------
......@@ -1101,7 +1094,7 @@ package body Prj.Env is
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);
......@@ -1142,9 +1135,9 @@ package body Prj.Env is
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);
......@@ -1180,10 +1173,12 @@ package body Prj.Env is
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;
......@@ -1237,14 +1232,14 @@ package body Prj.Env is
-- 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;
......@@ -1483,6 +1478,7 @@ package body Prj.Env is
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);
......@@ -1504,6 +1500,8 @@ package body Prj.Env is
end if;
end Recurse;
-- Start of processing for For_All_Imported_Projects
begin
Recurse (Project);
Reset (Seen);
......@@ -1534,6 +1532,9 @@ package body Prj.Env is
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;
......@@ -1557,6 +1558,7 @@ package body Prj.Env is
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.
......@@ -1571,6 +1573,9 @@ package body Prj.Env is
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;
......@@ -1666,11 +1671,11 @@ package body Prj.Env is
-- 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;
-------------------
......@@ -2089,43 +2094,43 @@ package body Prj.Env is
-- 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;
......@@ -2134,9 +2139,11 @@ package body Prj.Env is
-- 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;
-----------------------
......@@ -2145,7 +2152,6 @@ package body Prj.Env is
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
......@@ -2167,9 +2173,7 @@ package body Prj.Env is
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;
......
......@@ -28,9 +28,8 @@
package Prj.Env is
procedure Initialize;
-- Called by Prj.Initialize to perform required initialization steps for
-- this package.
procedure Initialize (In_Tree : Project_Tree_Ref);
-- Initialize global components relative to environment variables
procedure Print_Sources (In_Tree : Project_Tree_Ref);
-- Output the list of sources, after Project files have been scanned
......@@ -58,7 +57,8 @@ package Prj.Env is
-- for the specified project, and that is not information available in
-- buildgpr.adb.
procedure Set_Mapping_File_Initial_State_To_Empty;
procedure Set_Mapping_File_Initial_State_To_Empty
(In_Tree : Project_Tree_Ref);
-- When creating a mapping file, create an empty map. This case occurs when
-- run time source files are found in the project files. This only applies
-- to the Ada_Only mode.
......
......@@ -487,7 +487,8 @@ package body Prj.Nmsc is
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.
......@@ -723,14 +724,14 @@ package body Prj.Nmsc is
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;
......@@ -906,9 +907,10 @@ package body Prj.Nmsc is
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,
......@@ -2515,11 +2517,11 @@ package body Prj.Nmsc is
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
......@@ -2855,8 +2857,8 @@ package body Prj.Nmsc is
-----------------------------------
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;
......@@ -2949,8 +2951,8 @@ package body Prj.Nmsc is
-----------------------------------
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;
......@@ -6419,7 +6421,8 @@ package body Prj.Nmsc is
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;
......@@ -6575,7 +6578,7 @@ package body Prj.Nmsc is
-- 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;
......@@ -6684,7 +6687,8 @@ package body Prj.Nmsc is
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;
......@@ -7551,7 +7555,8 @@ package body Prj.Nmsc is
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;
......
......@@ -29,7 +29,6 @@ with Ada.Unchecked_Deallocation;
with Debug;
with Osint; use Osint;
with Prj.Attr;
with Prj.Env;
with Prj.Err; use Prj.Err;
with Snames; use Snames;
with Table;
......@@ -408,6 +407,7 @@ package body Prj is
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
......@@ -421,16 +421,20 @@ package body Prj is
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);
......@@ -610,7 +614,6 @@ package body Prj is
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));
......@@ -630,8 +633,10 @@ package body Prj is
(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;
......@@ -673,8 +678,7 @@ package body Prj is
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
......@@ -706,9 +710,9 @@ package body Prj is
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
......@@ -853,6 +857,7 @@ package body Prj is
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);
......@@ -898,8 +903,6 @@ package body Prj is
procedure Reset (Tree : Project_Tree_Ref) is
begin
Prj.Env.Initialize;
-- Visible tables
Name_List_Table.Init (Tree.Name_Lists);
......@@ -945,6 +948,13 @@ package body Prj is
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;
......
......@@ -1563,19 +1563,19 @@ private
-- Initialize.
type Source_Iterator is record
In_Tree : Project_Tree_Ref;
In_Tree : Project_Tree_Ref;
Project : Project_Id;
All_Projects : Boolean;
Project : Project_Id;
All_Projects : Boolean;
-- Current project and whether we should move on to the next
Language : Language_Ptr;
Language : Language_Ptr;
-- Current language processed
Language_Name : Name_Id;
-- Only sources of this language will be returned (or all if No_Name)
Current : Source_Id;
Current : Source_Id;
end record;
procedure Add_To_Buffer
......@@ -1625,6 +1625,33 @@ private
Source_Paths : Source_Path_Table.Instance;
Object_Paths : Object_Path_Table.Instance;
Default_Naming : Naming_Data;
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.
Fill_Mapping_File : Boolean := True;
end record;
-- Type to represent the part of a project tree which is private to the
-- Project Manager.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment