-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2011, 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- --
with Ada.Unchecked_Deallocation;
with GNAT.Case_Util; use GNAT.Case_Util;
+with GNAT.Regexp; use GNAT.Regexp;
with Osint; use Osint;
with Output; use Output;
+with Opt;
with Prj.Com;
with Snames; use Snames;
+with Table;
with Targparm; use Targparm;
+with GNAT.HTable;
+
package body Prj.Util is
+ package Source_Info_Table is new Table.Table
+ (Table_Component_Type => Source_Info_Iterator,
+ Table_Index_Type => Natural,
+ Table_Low_Bound => 1,
+ Table_Initial => 10,
+ Table_Increment => 100,
+ Table_Name => "Makeutl.Source_Info_Table");
+
+ package Source_Info_Project_HTable is new GNAT.HTable.Simple_HTable
+ (Header_Num => Prj.Header_Num,
+ Element => Natural,
+ No_Element => 0,
+ Key => Name_Id,
+ Hash => Prj.Hash,
+ Equal => "=");
+
procedure Free is new Ada.Unchecked_Deallocation
(Text_File_Data, Text_File);
-----------
procedure Close (File : in out Text_File) is
+ Len : Integer;
+ Status : Boolean;
+
begin
if File = null then
Prj.Com.Fail ("Close attempted on an invalid Text_File");
end if;
- -- Close file, no need to test status, since this is a file that we
- -- read, and the file was read successfully before we closed it.
+ if File.Out_File then
+ if File.Buffer_Len > 0 then
+ Len := Write (File.FD, File.Buffer'Address, File.Buffer_Len);
+
+ if Len /= File.Buffer_Len then
+ Prj.Com.Fail ("Unable to write to an out Text_File");
+ end if;
+ end if;
+
+ Close (File.FD, Status);
+
+ if not Status then
+ Prj.Com.Fail ("Unable to close an out Text_File");
+ end if;
+
+ else
+
+ -- Close in file, no need to test status, since this is a file that
+ -- we read, and the file was read successfully before we closed it.
+
+ Close (File.FD);
+ end if;
- Close (File.FD);
Free (File);
end Close;
+ ------------
+ -- Create --
+ ------------
+
+ procedure Create (File : out Text_File; Name : String) is
+ FD : File_Descriptor;
+ File_Name : String (1 .. Name'Length + 1);
+
+ begin
+ File_Name (1 .. Name'Length) := Name;
+ File_Name (File_Name'Last) := ASCII.NUL;
+ FD := Create_File (Name => File_Name'Address,
+ Fmode => GNAT.OS_Lib.Text);
+
+ if FD = Invalid_FD then
+ File := null;
+
+ else
+ File := new Text_File_Data;
+ File.FD := FD;
+ File.Out_File := True;
+ File.End_Of_File_Reached := True;
+ end if;
+ end Create;
+
---------------
-- Duplicate --
---------------
procedure Duplicate
- (This : in out Name_List_Index;
- In_Tree : Project_Tree_Ref)
+ (This : in out Name_List_Index;
+ Shared : Shared_Project_Tree_Data_Access)
is
Old_Current : Name_List_Index;
New_Current : Name_List_Index;
begin
if This /= No_Name_List then
Old_Current := This;
- Name_List_Table.Increment_Last (In_Tree.Name_Lists);
- New_Current := Name_List_Table.Last (In_Tree.Name_Lists);
+ Name_List_Table.Increment_Last (Shared.Name_Lists);
+ New_Current := Name_List_Table.Last (Shared.Name_Lists);
This := New_Current;
- In_Tree.Name_Lists.Table (New_Current) :=
- (In_Tree.Name_Lists.Table (Old_Current).Name, No_Name_List);
+ Shared.Name_Lists.Table (New_Current) :=
+ (Shared.Name_Lists.Table (Old_Current).Name, No_Name_List);
loop
- Old_Current := In_Tree.Name_Lists.Table (Old_Current).Next;
+ Old_Current := Shared.Name_Lists.Table (Old_Current).Next;
exit when Old_Current = No_Name_List;
- In_Tree.Name_Lists.Table (New_Current).Next := New_Current + 1;
- Name_List_Table.Increment_Last (In_Tree.Name_Lists);
+ Shared.Name_Lists.Table (New_Current).Next := New_Current + 1;
+ Name_List_Table.Increment_Last (Shared.Name_Lists);
New_Current := New_Current + 1;
- In_Tree.Name_Lists.Table (New_Current) :=
- (In_Tree.Name_Lists.Table (Old_Current).Name, No_Name_List);
+ Shared.Name_Lists.Table (New_Current) :=
+ (Shared.Name_Lists.Table (Old_Current).Name, No_Name_List);
end loop;
end if;
end Duplicate;
function Executable_Of
(Project : Project_Id;
- In_Tree : Project_Tree_Ref;
+ Shared : Shared_Project_Tree_Data_Access;
Main : File_Name_Type;
Index : Int;
Ada_Main : Boolean := True;
- Language : String := "") return File_Name_Type
+ Language : String := "";
+ Include_Suffix : Boolean := True) return File_Name_Type
is
pragma Assert (Project /= No_Project);
Prj.Util.Value_Of
(Name => Name_Builder,
In_Packages => The_Packages,
- In_Tree => In_Tree);
+ Shared => Shared);
Executable : Variable_Value :=
Prj.Util.Value_Of
Index => Index,
Attribute_Or_Array_Name => Name_Executable,
In_Package => Builder_Package,
- In_Tree => In_Tree);
-
- Executable_Suffix : Variable_Value := Nil_Variable_Value;
-
- Executable_Suffix_Name : Name_Id := No_Name;
+ Shared => Shared);
Lang : Language_Ptr;
S_Suffix : File_Name_Type);
-- Get the non empty suffixes in variables Spec_Suffix and Body_Suffix
+ function Add_Suffix (File : File_Name_Type) return File_Name_Type;
+ -- Return the name of the executable, based on File, and adding the
+ -- executable suffix if needed
+
------------------
-- Get_Suffixes --
------------------
end if;
end Get_Suffixes;
+ ----------------
+ -- Add_Suffix --
+ ----------------
+
+ function Add_Suffix (File : File_Name_Type) return File_Name_Type is
+ Saved_EEOT : constant Name_Id := Executable_Extension_On_Target;
+ Result : File_Name_Type;
+ Suffix_From_Project : Variable_Value;
+ begin
+ if Include_Suffix then
+ if Project.Config.Executable_Suffix /= No_Name then
+ Executable_Extension_On_Target :=
+ Project.Config.Executable_Suffix;
+ end if;
+
+ Result := Executable_Name (File);
+ Executable_Extension_On_Target := Saved_EEOT;
+ return Result;
+
+ elsif Builder_Package /= No_Package then
+
+ -- If the suffix is specified in the project itself, as opposed to
+ -- the config file, it needs to be taken into account. However,
+ -- when the project was processed, in both cases the suffix was
+ -- stored in Project.Config, so get it from the project again.
+
+ Suffix_From_Project :=
+ Prj.Util.Value_Of
+ (Variable_Name => Name_Executable_Suffix,
+ In_Variables =>
+ Shared.Packages.Table (Builder_Package).Decl.Attributes,
+ Shared => Shared);
+
+ if Suffix_From_Project /= Nil_Variable_Value
+ and then Suffix_From_Project.Value /= No_Name
+ then
+ Executable_Extension_On_Target := Suffix_From_Project.Value;
+ Result := Executable_Name (File);
+ Executable_Extension_On_Target := Saved_EEOT;
+ return Result;
+ end if;
+ end if;
+
+ return File;
+ end Add_Suffix;
+
-- Start of processing for Executable_Of
begin
end if;
if Builder_Package /= No_Package then
- if Get_Mode = Multi_Language then
- Executable_Suffix_Name := Project.Config.Executable_Suffix;
-
- else
- Executable_Suffix := Prj.Util.Value_Of
- (Variable_Name => Name_Executable_Suffix,
- In_Variables => In_Tree.Packages.Table
- (Builder_Package).Decl.Attributes,
- In_Tree => In_Tree);
-
- if Executable_Suffix /= Nil_Variable_Value
- and then not Executable_Suffix.Default
- then
- Executable_Suffix_Name := Executable_Suffix.Value;
- end if;
- end if;
-
- if Executable = Nil_Variable_Value and Ada_Main then
+ if Executable = Nil_Variable_Value and then Ada_Main then
Get_Name_String (Main);
-- Try as index the name minus the implementation suffix or minus
Index => 0,
Attribute_Or_Array_Name => Name_Executable,
In_Package => Builder_Package,
- In_Tree => In_Tree);
+ Shared => Shared);
end if;
end;
end if;
-- possibly suffixed by the executable suffix.
if Executable /= Nil_Variable_Value
- and then Executable.Value /= Empty_Name
+ and then Executable.Value /= No_Name
+ and then Length_Of_Name (Executable.Value) /= 0
then
- -- Get the executable name. If Executable_Suffix is defined,
- -- make sure that it will be the extension of the executable.
-
- declare
- Saved_EEOT : constant Name_Id := Executable_Extension_On_Target;
- Result : File_Name_Type;
-
- begin
- if Executable_Suffix_Name /= No_Name then
- Executable_Extension_On_Target := Executable_Suffix_Name;
- end if;
-
- Result := Executable_Name (File_Name_Type (Executable.Value));
- Executable_Extension_On_Target := Saved_EEOT;
- return Result;
- end;
+ return Add_Suffix (File_Name_Type (Executable.Value));
end if;
end if;
Get_Name_String (Strip_Suffix (Main));
end if;
- if Executable_Suffix /= Nil_Variable_Value
- and then not Executable_Suffix.Default
- then
- -- If attribute Executable_Suffix is specified, add this suffix
-
- declare
- Suffix : constant String :=
- Get_Name_String (Executable_Suffix.Value);
- begin
- Name_Buffer (Name_Len + 1 .. Name_Len + Suffix'Length) := Suffix;
- Name_Len := Name_Len + Suffix'Length;
- return Name_Find;
- end;
-
- else
- -- Get the executable name. If Executable_Suffix is defined in the
- -- configuration, make sure that it will be the extension of the
- -- executable.
-
- declare
- Saved_EEOT : constant Name_Id := Executable_Extension_On_Target;
- Result : File_Name_Type;
-
- begin
- if Project.Config.Executable_Suffix /= No_Name then
- Executable_Extension_On_Target :=
- Project.Config.Executable_Suffix;
- end if;
-
- Result := Executable_Name (Name_Find);
- Executable_Extension_On_Target := Saved_EEOT;
- return Result;
- end;
- end if;
+ return Add_Suffix (Name_Find);
end Executable_Of;
--------------
begin
if File = null then
Prj.Com.Fail ("Get_Line attempted on an invalid Text_File");
+
+ elsif File.Out_File then
+ Prj.Com.Fail ("Get_Line attempted on an out file");
end if;
Last := Line'First - 1;
end if;
end Get_Line;
+ ----------------
+ -- Initialize --
+ ----------------
+
+ procedure Initialize
+ (Iter : out Source_Info_Iterator;
+ For_Project : Name_Id)
+ is
+ Ind : constant Natural := Source_Info_Project_HTable.Get (For_Project);
+ begin
+ if Ind = 0 then
+ Iter := (No_Source_Info, 0);
+ else
+ Iter := Source_Info_Table.Table (Ind);
+ end if;
+ end Initialize;
+
--------------
-- Is_Valid --
--------------
end Is_Valid;
----------
+ -- Next --
+ ----------
+
+ procedure Next (Iter : in out Source_Info_Iterator) is
+ begin
+ if Iter.Next = 0 then
+ Iter.Info := No_Source_Info;
+
+ else
+ Iter := Source_Info_Table.Table (Iter.Next);
+ end if;
+ end Next;
+
+ ----------
-- Open --
----------
In_Tree : Project_Tree_Ref;
Lower_Case : Boolean := False)
is
+ Shared : constant Shared_Project_Tree_Data_Access := In_Tree.Shared;
+
Current_Name : Name_List_Index;
List : String_List_Id;
Element : String_Element;
Last : Name_List_Index :=
- Name_List_Table.Last (In_Tree.Name_Lists);
+ Name_List_Table.Last (Shared.Name_Lists);
Value : Name_Id;
begin
Current_Name := Into_List;
while Current_Name /= No_Name_List
- and then In_Tree.Name_Lists.Table (Current_Name).Next /= No_Name_List
+ and then Shared.Name_Lists.Table (Current_Name).Next /= No_Name_List
loop
- Current_Name := In_Tree.Name_Lists.Table (Current_Name).Next;
+ Current_Name := Shared.Name_Lists.Table (Current_Name).Next;
end loop;
List := From_List;
while List /= Nil_String loop
- Element := In_Tree.String_Elements.Table (List);
+ Element := Shared.String_Elements.Table (List);
Value := Element.Value;
if Lower_Case then
end if;
Name_List_Table.Append
- (In_Tree.Name_Lists, (Name => Value, Next => No_Name_List));
+ (Shared.Name_Lists, (Name => Value, Next => No_Name_List));
Last := Last + 1;
if Current_Name = No_Name_List then
Into_List := Last;
-
else
- In_Tree.Name_Lists.Table (Current_Name).Next := Last;
+ Shared.Name_Lists.Table (Current_Name).Next := Last;
end if;
Current_Name := Last;
end loop;
end Put;
+ procedure Put (File : Text_File; S : String) is
+ Len : Integer;
+ begin
+ if File = null then
+ Prj.Com.Fail ("Attempted to write on an invalid Text_File");
+
+ elsif not File.Out_File then
+ Prj.Com.Fail ("Attempted to write an in Text_File");
+ end if;
+
+ if File.Buffer_Len + S'Length > File.Buffer'Last then
+ -- Write buffer
+ Len := Write (File.FD, File.Buffer'Address, File.Buffer_Len);
+
+ if Len /= File.Buffer_Len then
+ Prj.Com.Fail ("Failed to write to an out Text_File");
+ end if;
+
+ File.Buffer_Len := 0;
+ end if;
+
+ File.Buffer (File.Buffer_Len + 1 .. File.Buffer_Len + S'Length) := S;
+ File.Buffer_Len := File.Buffer_Len + S'Length;
+ end Put;
+
+ --------------
+ -- Put_Line --
+ --------------
+
+ procedure Put_Line (File : Text_File; Line : String) is
+ L : String (1 .. Line'Length + 1);
+ begin
+ L (1 .. Line'Length) := Line;
+ L (L'Last) := ASCII.LF;
+ Put (File, L);
+ end Put_Line;
+
+ ---------------------------
+ -- Read_Source_Info_File --
+ ---------------------------
+
+ procedure Read_Source_Info_File (Tree : Project_Tree_Ref) is
+ File : Text_File;
+ Info : Source_Info_Iterator;
+ Proj : Name_Id;
+
+ procedure Report_Error;
+
+ ------------------
+ -- Report_Error --
+ ------------------
+
+ procedure Report_Error is
+ begin
+ Write_Line ("errors in source info file """ &
+ Tree.Source_Info_File_Name.all & '"');
+ Tree.Source_Info_File_Exists := False;
+ end Report_Error;
+
+ begin
+ Source_Info_Project_HTable.Reset;
+ Source_Info_Table.Init;
+
+ if Tree.Source_Info_File_Name = null then
+ Tree.Source_Info_File_Exists := False;
+ return;
+ end if;
+
+ Open (File, Tree.Source_Info_File_Name.all);
+
+ if not Is_Valid (File) then
+ if Opt.Verbose_Mode then
+ Write_Line ("source info file " & Tree.Source_Info_File_Name.all &
+ " does not exist");
+ end if;
+
+ Tree.Source_Info_File_Exists := False;
+ return;
+ end if;
+
+ Tree.Source_Info_File_Exists := True;
+
+ if Opt.Verbose_Mode then
+ Write_Line ("Reading source info file " &
+ Tree.Source_Info_File_Name.all);
+ end if;
+
+ Source_Loop :
+ while not End_Of_File (File) loop
+ Info := (new Source_Info_Data, 0);
+ Source_Info_Table.Increment_Last;
+
+ -- project name
+ Get_Line (File, Name_Buffer, Name_Len);
+ Proj := Name_Find;
+ Info.Info.Project := Proj;
+ Info.Next := Source_Info_Project_HTable.Get (Proj);
+ Source_Info_Project_HTable.Set (Proj, Source_Info_Table.Last);
+
+ if End_Of_File (File) then
+ Report_Error;
+ exit Source_Loop;
+ end if;
+
+ -- language name
+ Get_Line (File, Name_Buffer, Name_Len);
+ Info.Info.Language := Name_Find;
+
+ if End_Of_File (File) then
+ Report_Error;
+ exit Source_Loop;
+ end if;
+
+ -- kind
+ Get_Line (File, Name_Buffer, Name_Len);
+ Info.Info.Kind := Source_Kind'Value (Name_Buffer (1 .. Name_Len));
+
+ if End_Of_File (File) then
+ Report_Error;
+ exit Source_Loop;
+ end if;
+
+ -- display path name
+ Get_Line (File, Name_Buffer, Name_Len);
+ Info.Info.Display_Path_Name := Name_Find;
+ Info.Info.Path_Name := Info.Info.Display_Path_Name;
+
+ if End_Of_File (File) then
+ Report_Error;
+ exit Source_Loop;
+ end if;
+
+ -- optional fields
+ Option_Loop :
+ loop
+ Get_Line (File, Name_Buffer, Name_Len);
+ exit Option_Loop when Name_Len = 0;
+
+ if Name_Len <= 2 then
+ Report_Error;
+ exit Source_Loop;
+
+ else
+ if Name_Buffer (1 .. 2) = "P=" then
+ Name_Buffer (1 .. Name_Len - 2) :=
+ Name_Buffer (3 .. Name_Len);
+ Name_Len := Name_Len - 2;
+ Info.Info.Path_Name := Name_Find;
+
+ elsif Name_Buffer (1 .. 2) = "U=" then
+ Name_Buffer (1 .. Name_Len - 2) :=
+ Name_Buffer (3 .. Name_Len);
+ Name_Len := Name_Len - 2;
+ Info.Info.Unit_Name := Name_Find;
+
+ elsif Name_Buffer (1 .. 2) = "I=" then
+ Info.Info.Index := Int'Value (Name_Buffer (3 .. Name_Len));
+
+ elsif Name_Buffer (1 .. Name_Len) = "N=Y" then
+ Info.Info.Naming_Exception := Yes;
+
+ elsif Name_Buffer (1 .. Name_Len) = "N=I" then
+ Info.Info.Naming_Exception := Inherited;
+
+ else
+ Report_Error;
+ exit Source_Loop;
+ end if;
+ end if;
+ end loop Option_Loop;
+
+ Source_Info_Table.Table (Source_Info_Table.Last) := Info;
+ end loop Source_Loop;
+
+ Close (File);
+
+ exception
+ when others =>
+ Close (File);
+ Report_Error;
+ end Read_Source_Info_File;
+
+ --------------------
+ -- Source_Info_Of --
+ --------------------
+
+ function Source_Info_Of (Iter : Source_Info_Iterator) return Source_Info is
+ begin
+ return Iter.Info;
+ end Source_Info_Of;
+
--------------
-- Value_Of --
--------------
function Value_Of
(Index : Name_Id;
In_Array : Array_Element_Id;
- In_Tree : Project_Tree_Ref) return Name_Id
+ Shared : Shared_Project_Tree_Data_Access) return Name_Id
is
+
Current : Array_Element_Id;
Element : Array_Element;
Real_Index : Name_Id := Index;
return No_Name;
end if;
- Element := In_Tree.Array_Elements.Table (Current);
+ Element := Shared.Array_Elements.Table (Current);
if not Element.Index_Case_Sensitive then
Get_Name_String (Index);
end if;
while Current /= No_Array_Element loop
- Element := In_Tree.Array_Elements.Table (Current);
+ Element := Shared.Array_Elements.Table (Current);
if Real_Index = Element.Index then
exit when Element.Value.Kind /= Single;
(Index : Name_Id;
Src_Index : Int := 0;
In_Array : Array_Element_Id;
- In_Tree : Project_Tree_Ref;
- Force_Lower_Case_Index : Boolean := False) return Variable_Value
+ Shared : Shared_Project_Tree_Data_Access;
+ Force_Lower_Case_Index : Boolean := False;
+ Allow_Wildcards : Boolean := False) return Variable_Value
is
Current : Array_Element_Id;
Element : Array_Element;
return Nil_Variable_Value;
end if;
- Element := In_Tree.Array_Elements.Table (Current);
+ Element := Shared.Array_Elements.Table (Current);
Real_Index_1 := Index;
- if not Element.Index_Case_Sensitive or Force_Lower_Case_Index then
+ if not Element.Index_Case_Sensitive or else Force_Lower_Case_Index then
if Index /= All_Other_Names then
Get_Name_String (Index);
To_Lower (Name_Buffer (1 .. Name_Len));
end if;
while Current /= No_Array_Element loop
- Element := In_Tree.Array_Elements.Table (Current);
+ Element := Shared.Array_Elements.Table (Current);
Real_Index_2 := Element.Index;
- if not Element.Index_Case_Sensitive or Force_Lower_Case_Index then
+ if not Element.Index_Case_Sensitive
+ or else Force_Lower_Case_Index
+ then
if Element.Index /= All_Other_Names then
Get_Name_String (Element.Index);
To_Lower (Name_Buffer (1 .. Name_Len));
end if;
end if;
- if Real_Index_1 = Real_Index_2 and then
- Src_Index = Element.Src_Index
+ if Src_Index = Element.Src_Index and then
+ (Real_Index_1 = Real_Index_2 or else
+ (Real_Index_2 /= All_Other_Names and then
+ Allow_Wildcards and then
+ Match (Get_Name_String (Real_Index_1),
+ Compile (Get_Name_String (Real_Index_2),
+ Glob => True))))
then
return Element.Value;
else
Index : Int := 0;
Attribute_Or_Array_Name : Name_Id;
In_Package : Package_Id;
- In_Tree : Project_Tree_Ref;
- Force_Lower_Case_Index : Boolean := False) return Variable_Value
+ Shared : Shared_Project_Tree_Data_Access;
+ Force_Lower_Case_Index : Boolean := False;
+ Allow_Wildcards : Boolean := False) return Variable_Value
is
The_Array : Array_Element_Id;
The_Attribute : Variable_Value := Nil_Variable_Value;
The_Array :=
Value_Of
(Name => Attribute_Or_Array_Name,
- In_Arrays => In_Tree.Packages.Table (In_Package).Decl.Arrays,
- In_Tree => In_Tree);
+ In_Arrays => Shared.Packages.Table (In_Package).Decl.Arrays,
+ Shared => Shared);
The_Attribute :=
Value_Of
(Index => Name,
Src_Index => Index,
In_Array => The_Array,
- In_Tree => In_Tree,
- Force_Lower_Case_Index => Force_Lower_Case_Index);
+ Shared => Shared,
+ Force_Lower_Case_Index => Force_Lower_Case_Index,
+ Allow_Wildcards => Allow_Wildcards);
-- If there is no array element, look for a variable
The_Attribute :=
Value_Of
(Variable_Name => Attribute_Or_Array_Name,
- In_Variables => In_Tree.Packages.Table
- (In_Package).Decl.Attributes,
- In_Tree => In_Tree);
+ In_Variables => Shared.Packages.Table
+ (In_Package).Decl.Attributes,
+ Shared => Shared);
end if;
end if;
(Index : Name_Id;
In_Array : Name_Id;
In_Arrays : Array_Id;
- In_Tree : Project_Tree_Ref) return Name_Id
+ Shared : Shared_Project_Tree_Data_Access) return Name_Id
is
Current : Array_Id;
The_Array : Array_Data;
begin
Current := In_Arrays;
while Current /= No_Array loop
- The_Array := In_Tree.Arrays.Table (Current);
+ The_Array := Shared.Arrays.Table (Current);
if The_Array.Name = In_Array then
return Value_Of
- (Index, In_Array => The_Array.Value, In_Tree => In_Tree);
+ (Index, In_Array => The_Array.Value, Shared => Shared);
else
Current := The_Array.Next;
end if;
function Value_Of
(Name : Name_Id;
In_Arrays : Array_Id;
- In_Tree : Project_Tree_Ref) return Array_Element_Id
+ Shared : Shared_Project_Tree_Data_Access) return Array_Element_Id
is
Current : Array_Id;
The_Array : Array_Data;
begin
Current := In_Arrays;
while Current /= No_Array loop
- The_Array := In_Tree.Arrays.Table (Current);
+ The_Array := Shared.Arrays.Table (Current);
if The_Array.Name = Name then
return The_Array.Value;
function Value_Of
(Name : Name_Id;
In_Packages : Package_Id;
- In_Tree : Project_Tree_Ref) return Package_Id
+ Shared : Shared_Project_Tree_Data_Access) return Package_Id
is
Current : Package_Id;
The_Package : Package_Element;
begin
Current := In_Packages;
while Current /= No_Package loop
- The_Package := In_Tree.Packages.Table (Current);
+ The_Package := Shared.Packages.Table (Current);
exit when The_Package.Name /= No_Name
and then The_Package.Name = Name;
Current := The_Package.Next;
function Value_Of
(Variable_Name : Name_Id;
In_Variables : Variable_Id;
- In_Tree : Project_Tree_Ref) return Variable_Value
+ Shared : Shared_Project_Tree_Data_Access) return Variable_Value
is
Current : Variable_Id;
The_Variable : Variable;
begin
Current := In_Variables;
while Current /= No_Variable loop
- The_Variable :=
- In_Tree.Variable_Elements.Table (Current);
+ The_Variable := Shared.Variable_Elements.Table (Current);
if Variable_Name = The_Variable.Name then
return The_Variable.Value;
return Nil_Variable_Value;
end Value_Of;
+ ----------------------------
+ -- Write_Source_Info_File --
+ ----------------------------
+
+ procedure Write_Source_Info_File (Tree : Project_Tree_Ref) is
+ Iter : Source_Iterator := For_Each_Source (Tree);
+ Source : Prj.Source_Id;
+ File : Text_File;
+
+ begin
+ if Opt.Verbose_Mode then
+ Write_Line ("Writing new source info file " &
+ Tree.Source_Info_File_Name.all);
+ end if;
+
+ Create (File, Tree.Source_Info_File_Name.all);
+
+ if not Is_Valid (File) then
+ Write_Line ("warning: unable to create source info file """ &
+ Tree.Source_Info_File_Name.all & '"');
+ return;
+ end if;
+
+ loop
+ Source := Element (Iter);
+ exit when Source = No_Source;
+
+ if not Source.Locally_Removed and then
+ Source.Replaced_By = No_Source
+ then
+ -- Project name
+
+ Put_Line (File, Get_Name_String (Source.Project.Name));
+
+ -- Language name
+
+ Put_Line (File, Get_Name_String (Source.Language.Name));
+
+ -- Kind
+
+ Put_Line (File, Source.Kind'Img);
+
+ -- Display path name
+
+ Put_Line (File, Get_Name_String (Source.Path.Display_Name));
+
+ -- Optional lines:
+
+ -- Path name (P=)
+
+ if Source.Path.Name /= Source.Path.Display_Name then
+ Put (File, "P=");
+ Put_Line (File, Get_Name_String (Source.Path.Name));
+ end if;
+
+ -- Unit name (U=)
+
+ if Source.Unit /= No_Unit_Index then
+ Put (File, "U=");
+ Put_Line (File, Get_Name_String (Source.Unit.Name));
+ end if;
+
+ -- Multi-source index (I=)
+
+ if Source.Index /= 0 then
+ Put (File, "I=");
+ Put_Line (File, Source.Index'Img);
+ end if;
+
+ -- Naming exception ("N=T");
+
+ if Source.Naming_Exception = Yes then
+ Put_Line (File, "N=Y");
+
+ elsif Source.Naming_Exception = Inherited then
+ Put_Line (File, "N=I");
+ end if;
+
+ -- Empty line to indicate end of info on this source
+
+ Put_Line (File, "");
+ end if;
+
+ Next (Iter);
+ end loop;
+
+ Close (File);
+ end Write_Source_Info_File;
+
---------------
-- Write_Str --
---------------
OSDN Git Service
