-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2005 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- --
-------------------
function Executable_Of
- (Project : Project_Id; Main : Name_Id) return Name_Id
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Main : Name_Id;
+ Index : Int;
+ Ada_Main : Boolean := True) return Name_Id
is
pragma Assert (Project /= No_Project);
The_Packages : constant Package_Id :=
- Projects.Table (Project).Decl.Packages;
+ In_Tree.Projects.Table (Project).Decl.Packages;
Builder_Package : constant Prj.Package_Id :=
Prj.Util.Value_Of
(Name => Name_Builder,
- In_Packages => The_Packages);
+ In_Packages => The_Packages,
+ In_Tree => In_Tree);
Executable : Variable_Value :=
Prj.Util.Value_Of
(Name => Main,
+ Index => Index,
Attribute_Or_Array_Name => Name_Executable,
- In_Package => Builder_Package);
+ In_Package => Builder_Package,
+ In_Tree => In_Tree);
- Executable_Suffix : Variable_Value :=
+ Executable_Suffix : constant Variable_Value :=
Prj.Util.Value_Of
(Name => Main,
+ Index => 0,
Attribute_Or_Array_Name =>
Name_Executable_Suffix,
- In_Package => Builder_Package);
+ In_Package => Builder_Package,
+ In_Tree => In_Tree);
Body_Append : constant String := Get_Name_String
- (Projects.Table
+ (In_Tree.Projects.Table
(Project).
- Naming.Current_Body_Suffix);
+ Naming.Ada_Body_Suffix);
Spec_Append : constant String := Get_Name_String
- (Projects.Table
+ (In_Tree.Projects.Table
(Project).
- Naming.Current_Spec_Suffix);
+ Naming.Ada_Spec_Suffix);
begin
if Builder_Package /= No_Package then
- if Executable = Nil_Variable_Value then
+ if Executable = Nil_Variable_Value and Ada_Main then
Get_Name_String (Main);
-- Try as index the name minus the implementation suffix or minus
-- the specification suffix.
declare
- Name : String (1 .. Name_Len) := Name_Buffer (1 .. Name_Len);
+ Name : constant String (1 .. Name_Len) :=
+ Name_Buffer (1 .. Name_Len);
Last : Positive := Name_Len;
Naming : constant Naming_Data :=
- Projects.Table (Project).Naming;
+ In_Tree.Projects.Table (Project).Naming;
Spec_Suffix : constant String :=
- Get_Name_String (Naming.Current_Spec_Suffix);
+ Get_Name_String (Naming.Ada_Spec_Suffix);
Body_Suffix : constant String :=
- Get_Name_String (Naming.Current_Body_Suffix);
+ Get_Name_String (Naming.Ada_Body_Suffix);
Truncated : Boolean := False;
Executable :=
Prj.Util.Value_Of
(Name => Name_Find,
+ Index => 0,
Attribute_Or_Array_Name => Name_Executable,
- In_Package => Builder_Package);
+ In_Package => Builder_Package,
+ In_Tree => In_Tree);
end if;
end;
end if;
-- otherwise remove any suffix ('.' followed by other characters), if
-- there is one.
- if Name_Len > Body_Append'Length
+ if Ada_Main and then Name_Len > Body_Append'Length
and then Name_Buffer (Name_Len - Body_Append'Length + 1 .. Name_Len) =
Body_Append
then
Name_Len := Name_Len - Body_Append'Length;
- elsif Name_Len > Spec_Append'Length
+ elsif Ada_Main and then Name_Len > Spec_Append'Length
and then Name_Buffer (Name_Len - Spec_Append'Length + 1 .. Name_Len) =
Spec_Append
then
function Value_Of
(Variable : Variable_Value;
- Default : String)
- return String
+ Default : String) return String
is
begin
if Variable.Kind /= Single
end Value_Of;
function Value_Of
- (Index : Name_Id;
- In_Array : Array_Element_Id)
- return Name_Id
+ (Index : Name_Id;
+ In_Array : Array_Element_Id;
+ In_Tree : Project_Tree_Ref) return Name_Id
is
Current : Array_Element_Id := In_Array;
Element : Array_Element;
return No_Name;
end if;
- Element := Array_Elements.Table (Current);
+ Element := In_Tree.Array_Elements.Table (Current);
if not Element.Index_Case_Sensitive then
Get_Name_String (Index);
end if;
while Current /= No_Array_Element loop
- Element := Array_Elements.Table (Current);
+ Element := In_Tree.Array_Elements.Table (Current);
if Real_Index = Element.Index then
exit when Element.Value.Kind /= Single;
end Value_Of;
function Value_Of
- (Index : Name_Id;
- In_Array : Array_Element_Id)
- return Variable_Value
+ (Index : Name_Id;
+ Src_Index : Int := 0;
+ In_Array : Array_Element_Id;
+ In_Tree : Project_Tree_Ref) return Variable_Value
is
Current : Array_Element_Id := In_Array;
Element : Array_Element;
return Nil_Variable_Value;
end if;
- Element := Array_Elements.Table (Current);
+ Element := In_Tree.Array_Elements.Table (Current);
if not Element.Index_Case_Sensitive then
Get_Name_String (Index);
end if;
while Current /= No_Array_Element loop
- Element := Array_Elements.Table (Current);
+ Element := In_Tree.Array_Elements.Table (Current);
- if Real_Index = Element.Index then
+ if Real_Index = Element.Index and then
+ Src_Index = Element.Src_Index
+ then
return Element.Value;
else
Current := Element.Next;
function Value_Of
(Name : Name_Id;
+ Index : Int := 0;
Attribute_Or_Array_Name : Name_Id;
- In_Package : Package_Id)
- return Variable_Value
+ In_Package : Package_Id;
+ In_Tree : Project_Tree_Ref) 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 => Packages.Table (In_Package).Decl.Arrays);
+ In_Arrays => In_Tree.Packages.Table (In_Package).Decl.Arrays,
+ In_Tree => In_Tree);
The_Attribute :=
Value_Of
- (Index => Name,
- In_Array => The_Array);
+ (Index => Name,
+ Src_Index => Index,
+ In_Array => The_Array,
+ In_Tree => In_Tree);
-- If there is no array element, look for a variable
The_Attribute :=
Value_Of
(Variable_Name => Attribute_Or_Array_Name,
- In_Variables => Packages.Table (In_Package).Decl.Attributes);
+ In_Variables => In_Tree.Packages.Table
+ (In_Package).Decl.Attributes,
+ In_Tree => In_Tree);
end if;
end if;
function Value_Of
(Index : Name_Id;
In_Array : Name_Id;
- In_Arrays : Array_Id)
- return Name_Id
+ In_Arrays : Array_Id;
+ In_Tree : Project_Tree_Ref) return Name_Id
is
Current : Array_Id := In_Arrays;
The_Array : Array_Data;
begin
while Current /= No_Array loop
- The_Array := Arrays.Table (Current);
+ The_Array := In_Tree.Arrays.Table (Current);
if The_Array.Name = In_Array then
- return Value_Of (Index, In_Array => The_Array.Value);
+ return Value_Of
+ (Index, In_Array => The_Array.Value, In_Tree => In_Tree);
else
Current := The_Array.Next;
end if;
function Value_Of
(Name : Name_Id;
- In_Arrays : Array_Id)
- return Array_Element_Id
+ In_Arrays : Array_Id;
+ In_Tree : Project_Tree_Ref) return Array_Element_Id
is
Current : Array_Id := In_Arrays;
The_Array : Array_Data;
begin
while Current /= No_Array loop
- The_Array := Arrays.Table (Current);
+ The_Array := In_Tree.Arrays.Table (Current);
if The_Array.Name = Name then
return The_Array.Value;
function Value_Of
(Name : Name_Id;
- In_Packages : Package_Id)
- return Package_Id
+ In_Packages : Package_Id;
+ In_Tree : Project_Tree_Ref) return Package_Id
is
Current : Package_Id := In_Packages;
The_Package : Package_Element;
begin
while Current /= No_Package loop
- The_Package := Packages.Table (Current);
+ The_Package := In_Tree.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)
- return Variable_Value
+ In_Variables : Variable_Id;
+ In_Tree : Project_Tree_Ref) return Variable_Value
is
Current : Variable_Id := In_Variables;
The_Variable : Variable;
begin
while Current /= No_Variable loop
- The_Variable := Variable_Elements.Table (Current);
+ The_Variable :=
+ In_Tree.Variable_Elements.Table (Current);
if Variable_Name = The_Variable.Name then
return The_Variable.Value;
OSDN Git Service
