with Err_Vars; use Err_Vars;
with Namet; use Namet;
with Opt;
with Osint; use Osint;
with Output; use Output;
with Prj.Attr; use Prj.Attr;
with Prj.Com; use Prj.Com;
with Prj.Err; use Prj.Err;
with Prj.Ext; use Prj.Ext;
with Prj.Nmsc; use Prj.Nmsc;
with Snames;
with GNAT.Case_Util; use GNAT.Case_Util;
with GNAT.HTable;
package body Prj.Proc is
Error_Report : Put_Line_Access := null;
package Processed_Projects is new GNAT.HTable.Simple_HTable
(Header_Num => Header_Num,
Element => Project_Id,
No_Element => No_Project,
Key => Name_Id,
Hash => Hash,
Equal => "=");
procedure Add (To_Exp : in out Name_Id; Str : Name_Id);
procedure Add_Attributes
(Project : Project_Id;
Decl : in out Declarations;
First : Attribute_Node_Id);
function Expression
(Project : Project_Id;
From_Project_Node : Project_Node_Id;
Pkg : Package_Id;
First_Term : Project_Node_Id;
Kind : Variable_Kind) return Variable_Value;
function Imported_Or_Extended_Project_From
(Project : Project_Id;
With_Name : Name_Id) return Project_Id;
function Package_From
(Project : Project_Id;
With_Name : Name_Id) return Package_Id;
procedure Process_Declarative_Items
(Project : Project_Id;
From_Project_Node : Project_Node_Id;
Pkg : Package_Id;
Item : Project_Node_Id);
procedure Recursive_Process
(Project : out Project_Id;
From_Project_Node : Project_Node_Id;
Extended_By : Project_Id);
procedure Check
(Project : in out Project_Id;
Process_Languages : Languages_Processed;
Follow_Links : Boolean);
procedure Recursive_Check
(Project : Project_Id;
Process_Languages : Languages_Processed;
Follow_Links : Boolean);
procedure Add (To_Exp : in out Name_Id; Str : Name_Id) is
begin
if To_Exp = Types.No_Name or else To_Exp = Empty_String then
To_Exp := Str;
elsif Str /= No_Name and then Str /= Empty_String then
declare
S : constant String := Get_Name_String (Str);
begin
Get_Name_String (To_Exp);
Add_Str_To_Name_Buffer (S);
To_Exp := Name_Find;
end;
end if;
end Add;
procedure Add_Attributes
(Project : Project_Id;
Decl : in out Declarations;
First : Attribute_Node_Id)
is
The_Attribute : Attribute_Node_Id := First;
Attribute_Data : Attribute_Record;
begin
while The_Attribute /= Empty_Attribute loop
Attribute_Data := Attributes.Table (The_Attribute);
if Attribute_Data.Kind_2 = Single then
declare
New_Attribute : Variable_Value;
begin
case Attribute_Data.Kind_1 is
when Undefined =>
pragma Assert
(False, "attribute with an undefined kind");
raise Program_Error;
when Single =>
New_Attribute :=
(Project => Project,
Kind => Single,
Location => No_Location,
Default => True,
Value => Empty_String,
Index => 0);
when List =>
New_Attribute :=
(Project => Project,
Kind => List,
Location => No_Location,
Default => True,
Values => Nil_String);
end case;
Variable_Elements.Increment_Last;
Variable_Elements.Table (Variable_Elements.Last) :=
(Next => Decl.Attributes,
Name => Attribute_Data.Name,
Value => New_Attribute);
Decl.Attributes := Variable_Elements.Last;
end;
end if;
The_Attribute := Attributes.Table (The_Attribute).Next;
end loop;
end Add_Attributes;
procedure Check
(Project : in out Project_Id;
Process_Languages : Languages_Processed;
Follow_Links : Boolean) is
begin
for Index in 1 .. Projects.Last loop
Projects.Table (Index).Checked := False;
end loop;
Recursive_Check (Project, Process_Languages, Follow_Links);
end Check;
function Expression
(Project : Project_Id;
From_Project_Node : Project_Node_Id;
Pkg : Package_Id;
First_Term : Project_Node_Id;
Kind : Variable_Kind) return Variable_Value
is
The_Term : Project_Node_Id := First_Term;
The_Current_Term : Project_Node_Id := Empty_Node;
Result : Variable_Value (Kind => Kind);
Last : String_List_Id := Nil_String;
begin
Result.Project := Project;
Result.Location := Location_Of (First_Term);
while The_Term /= Empty_Node loop
The_Current_Term := Current_Term (The_Term);
case Kind_Of (The_Current_Term) is
when N_Literal_String =>
case Kind is
when Undefined =>
pragma Assert (False, "Undefined expression kind");
raise Program_Error;
when Single =>
Add (Result.Value, String_Value_Of (The_Current_Term));
Result.Index := Source_Index_Of (The_Current_Term);
when List =>
String_Elements.Increment_Last;
if Last = Nil_String then
Result.Values := String_Elements.Last;
else
String_Elements.Table (Last).Next :=
String_Elements.Last;
end if;
Last := String_Elements.Last;
String_Elements.Table (Last) :=
(Value => String_Value_Of (The_Current_Term),
Index => Source_Index_Of (The_Current_Term),
Display_Value => No_Name,
Location => Location_Of (The_Current_Term),
Flag => False,
Next => Nil_String);
end case;
when N_Literal_String_List =>
declare
String_Node : Project_Node_Id :=
First_Expression_In_List (The_Current_Term);
Value : Variable_Value;
begin
if String_Node /= Empty_Node then
Value := Expression
(Project => Project,
From_Project_Node => From_Project_Node,
Pkg => Pkg,
First_Term => Tree.First_Term (String_Node),
Kind => Single);
String_Elements.Increment_Last;
if Result.Values = Nil_String then
Result.Values := String_Elements.Last;
else
String_Elements.Table (Last).Next :=
String_Elements.Last;
end if;
Last := String_Elements.Last;
String_Elements.Table (Last) :=
(Value => Value.Value,
Display_Value => No_Name,
Location => Value.Location,
Flag => False,
Next => Nil_String,
Index => Value.Index);
loop
String_Node :=
Next_Expression_In_List (String_Node);
exit when String_Node = Empty_Node;
Value :=
Expression
(Project => Project,
From_Project_Node => From_Project_Node,
Pkg => Pkg,
First_Term => Tree.First_Term (String_Node),
Kind => Single);
String_Elements.Increment_Last;
String_Elements.Table (Last).Next :=
String_Elements.Last;
Last := String_Elements.Last;
String_Elements.Table (Last) :=
(Value => Value.Value,
Display_Value => No_Name,
Location => Value.Location,
Flag => False,
Next => Nil_String,
Index => Value.Index);
end loop;
end if;
end;
when N_Variable_Reference | N_Attribute_Reference =>
declare
The_Project : Project_Id := Project;
The_Package : Package_Id := Pkg;
The_Name : Name_Id := No_Name;
The_Variable_Id : Variable_Id := No_Variable;
The_Variable : Variable_Value;
Term_Project : constant Project_Node_Id :=
Project_Node_Of (The_Current_Term);
Term_Package : constant Project_Node_Id :=
Package_Node_Of (The_Current_Term);
Index : Name_Id := No_Name;
begin
if Term_Project /= Empty_Node and then
Term_Project /= From_Project_Node
then
The_Name := Name_Of (Term_Project);
The_Project := Imported_Or_Extended_Project_From
(Project => Project,
With_Name => The_Name);
end if;
if Term_Package /= Empty_Node then
The_Name := Name_Of (Term_Package);
The_Package := Projects.Table (The_Project).Decl.Packages;
while The_Package /= No_Package
and then Packages.Table (The_Package).Name /= The_Name
loop
The_Package := Packages.Table (The_Package).Next;
end loop;
pragma Assert
(The_Package /= No_Package,
"package not found.");
elsif Kind_Of (The_Current_Term) = N_Attribute_Reference then
The_Package := No_Package;
end if;
The_Name := Name_Of (The_Current_Term);
if Kind_Of (The_Current_Term) = N_Attribute_Reference then
Index := Associative_Array_Index_Of (The_Current_Term);
end if;
if Index = No_Name then
if The_Package /= No_Package then
if
Kind_Of (The_Current_Term) = N_Variable_Reference
then
The_Variable_Id :=
Packages.Table (The_Package).Decl.Variables;
else
The_Variable_Id :=
Packages.Table (The_Package).Decl.Attributes;
end if;
while The_Variable_Id /= No_Variable
and then
Variable_Elements.Table (The_Variable_Id).Name /=
The_Name
loop
The_Variable_Id :=
Variable_Elements.Table (The_Variable_Id).Next;
end loop;
end if;
if The_Variable_Id = No_Variable then
if
Kind_Of (The_Current_Term) = N_Variable_Reference
then
The_Variable_Id :=
Projects.Table (The_Project).Decl.Variables;
else
The_Variable_Id :=
Projects.Table (The_Project).Decl.Attributes;
end if;
while The_Variable_Id /= No_Variable
and then
Variable_Elements.Table (The_Variable_Id).Name /=
The_Name
loop
The_Variable_Id :=
Variable_Elements.Table (The_Variable_Id).Next;
end loop;
end if;
pragma Assert (The_Variable_Id /= No_Variable,
"variable or attribute not found");
The_Variable := Variable_Elements.Table
(The_Variable_Id).Value;
else
declare
The_Array : Array_Id := No_Array;
The_Element : Array_Element_Id := No_Array_Element;
Array_Index : Name_Id := No_Name;
begin
if The_Package /= No_Package then
The_Array :=
Packages.Table (The_Package).Decl.Arrays;
else
The_Array :=
Projects.Table (The_Project).Decl.Arrays;
end if;
while The_Array /= No_Array
and then Arrays.Table (The_Array).Name /= The_Name
loop
The_Array := Arrays.Table (The_Array).Next;
end loop;
if The_Array /= No_Array then
The_Element := Arrays.Table (The_Array).Value;
Get_Name_String (Index);
if Case_Insensitive (The_Current_Term) then
To_Lower (Name_Buffer (1 .. Name_Len));
end if;
Array_Index := Name_Find;
while The_Element /= No_Array_Element
and then Array_Elements.Table (The_Element).Index
/= Array_Index
loop
The_Element :=
Array_Elements.Table (The_Element).Next;
end loop;
end if;
if The_Element /= No_Array_Element then
The_Variable :=
Array_Elements.Table (The_Element).Value;
else
if
Expression_Kind_Of (The_Current_Term) = List
then
The_Variable :=
(Project => Project,
Kind => List,
Location => No_Location,
Default => True,
Values => Nil_String);
else
The_Variable :=
(Project => Project,
Kind => Single,
Location => No_Location,
Default => True,
Value => Empty_String,
Index => 0);
end if;
end if;
end;
end if;
case Kind is
when Undefined =>
pragma Assert (False, "undefined expression kind");
null;
when Single =>
case The_Variable.Kind is
when Undefined =>
null;
when Single =>
Add (Result.Value, The_Variable.Value);
when List =>
pragma Assert
(False,
"list cannot appear in single " &
"string expression");
null;
end case;
when List =>
case The_Variable.Kind is
when Undefined =>
null;
when Single =>
String_Elements.Increment_Last;
if Last = Nil_String then
Result.Values := String_Elements.Last;
else
String_Elements.Table (Last).Next :=
String_Elements.Last;
end if;
Last := String_Elements.Last;
String_Elements.Table (Last) :=
(Value => The_Variable.Value,
Display_Value => No_Name,
Location => Location_Of (The_Current_Term),
Flag => False,
Next => Nil_String,
Index => 0);
when List =>
declare
The_List : String_List_Id :=
The_Variable.Values;
begin
while The_List /= Nil_String loop
String_Elements.Increment_Last;
if Last = Nil_String then
Result.Values := String_Elements.Last;
else
String_Elements.Table (Last).Next :=
String_Elements.Last;
end if;
Last := String_Elements.Last;
String_Elements.Table (Last) :=
(Value =>
String_Elements.Table
(The_List).Value,
Display_Value => No_Name,
Location => Location_Of
(The_Current_Term),
Flag => False,
Next => Nil_String,
Index => 0);
The_List :=
String_Elements.Table (The_List).Next;
end loop;
end;
end case;
end case;
end;
when N_External_Value =>
Get_Name_String
(String_Value_Of (External_Reference_Of (The_Current_Term)));
declare
Name : constant Name_Id := Name_Find;
Default : Name_Id := No_Name;
Value : Name_Id := No_Name;
Default_Node : constant Project_Node_Id :=
External_Default_Of (The_Current_Term);
begin
if Default_Node /= Empty_Node then
Default := String_Value_Of (Default_Node);
end if;
Value := Prj.Ext.Value_Of (Name, Default);
if Value = No_Name then
if not Opt.Quiet_Output then
if Error_Report = null then
Error_Msg
("?undefined external reference",
Location_Of (The_Current_Term));
else
Error_Report
("warning: """ & Get_Name_String (Name) &
""" is an undefined external reference",
Project);
end if;
end if;
Value := Empty_String;
end if;
case Kind is
when Undefined =>
null;
when Single =>
Add (Result.Value, Value);
when List =>
String_Elements.Increment_Last;
if Last = Nil_String then
Result.Values := String_Elements.Last;
else
String_Elements.Table (Last).Next :=
String_Elements.Last;
end if;
Last := String_Elements.Last;
String_Elements.Table (Last) :=
(Value => Value,
Display_Value => No_Name,
Location => Location_Of (The_Current_Term),
Flag => False,
Next => Nil_String,
Index => 0);
end case;
end;
when others =>
pragma Assert
(False,
"illegal node kind in an expression");
raise Program_Error;
end case;
The_Term := Next_Term (The_Term);
end loop;
return Result;
end Expression;
function Imported_Or_Extended_Project_From
(Project : Project_Id;
With_Name : Name_Id) return Project_Id
is
Data : constant Project_Data := Projects.Table (Project);
List : Project_List := Data.Imported_Projects;
begin
if Data.Extends /= No_Project
and then Projects.Table (Data.Extends).Name = With_Name
then
return Data.Extends;
else
while List /= Empty_Project_List
and then
Projects.Table
(Project_Lists.Table (List).Project).Name /= With_Name
loop
List := Project_Lists.Table (List).Next;
end loop;
pragma Assert
(List /= Empty_Project_List,
"project not found");
return Project_Lists.Table (List).Project;
end if;
end Imported_Or_Extended_Project_From;
function Package_From
(Project : Project_Id;
With_Name : Name_Id) return Package_Id
is
Data : constant Project_Data := Projects.Table (Project);
Result : Package_Id := Data.Decl.Packages;
begin
while Result /= No_Package
and then
Packages.Table (Result).Name /= With_Name
loop
Result := Packages.Table (Result).Next;
end loop;
if Result = No_Package then
Write_Line ("package """ & Get_Name_String (With_Name) &
""" not found");
raise Program_Error;
else
return Result;
end if;
end Package_From;
procedure Process
(Project : out Project_Id;
Success : out Boolean;
From_Project_Node : Project_Node_Id;
Report_Error : Put_Line_Access;
Process_Languages : Languages_Processed := Ada_Language;
Follow_Links : Boolean := True)
is
Obj_Dir : Name_Id;
Extending : Project_Id;
Extending2 : Project_Id;
begin
Error_Report := Report_Error;
Success := True;
Projects.Set_Last (No_Project);
Processed_Projects.Reset;
Recursive_Process
(Project => Project,
From_Project_Node => From_Project_Node,
Extended_By => No_Project);
if Project /= No_Project then
Check (Project, Process_Languages, Follow_Links);
end if;
if Project /= No_Project
and then Is_Extending_All (From_Project_Node)
then
declare
Object_Dir : constant Name_Id :=
Projects.Table (Project).Object_Directory;
begin
for Index in Projects.First .. Projects.Last loop
if Projects.Table (Index).Virtual then
Projects.Table (Index).Object_Directory := Object_Dir;
end if;
end loop;
end;
end if;
if Project /= No_Project then
for Proj in 1 .. Projects.Last loop
Extending := Projects.Table (Proj).Extended_By;
if Extending /= No_Project then
Obj_Dir := Projects.Table (Proj).Object_Directory;
Extending2 := Extending;
while Extending2 /= No_Project loop
if Projects.Table (Extending2).Sources_Present
and then
Projects.Table (Extending2).Object_Directory = Obj_Dir
then
if Projects.Table (Extending2).Virtual then
Error_Msg_Name_1 := Projects.Table (Proj).Name;
if Error_Report = null then
Error_Msg
("project % cannot be extended by a virtual " &
"project with the same object directory",
Projects.Table (Proj).Location);
else
Error_Report
("project """ &
Get_Name_String (Error_Msg_Name_1) &
""" cannot be extended by a virtual " &
"project with the same object directory",
Project);
end if;
else
Error_Msg_Name_1 :=
Projects.Table (Extending2).Name;
Error_Msg_Name_2 := Projects.Table (Proj).Name;
if Error_Report = null then
Error_Msg
("project % cannot extend project %",
Projects.Table (Extending2).Location);
Error_Msg
("\they share the same object directory",
Projects.Table (Extending2).Location);
else
Error_Report
("project """ &
Get_Name_String (Error_Msg_Name_1) &
""" cannot extend project """ &
Get_Name_String (Error_Msg_Name_2) & """",
Project);
Error_Report
("they share the same object directory",
Project);
end if;
end if;
end if;
Extending2 := Projects.Table (Extending2).Extended_By;
end loop;
end if;
end loop;
end if;
Success := Total_Errors_Detected <= 0;
end Process;
procedure Process_Declarative_Items
(Project : Project_Id;
From_Project_Node : Project_Node_Id;
Pkg : Package_Id;
Item : Project_Node_Id)
is
Current_Declarative_Item : Project_Node_Id := Item;
Current_Item : Project_Node_Id := Empty_Node;
begin
while Current_Declarative_Item /= Empty_Node loop
Current_Item := Current_Item_Node (Current_Declarative_Item);
Current_Declarative_Item := Next_Declarative_Item
(Current_Declarative_Item);
case Kind_Of (Current_Item) is
when N_Package_Declaration =>
if Expression_Kind_Of (Current_Item) /= Ignored then
Packages.Increment_Last;
declare
New_Pkg : constant Package_Id := Packages.Last;
The_New_Package : Package_Element;
Project_Of_Renamed_Package : constant Project_Node_Id :=
Project_Of_Renamed_Package_Of
(Current_Item);
begin
The_New_Package.Name := Name_Of (Current_Item);
if Pkg /= No_Package then
The_New_Package.Next :=
Packages.Table (Pkg).Decl.Packages;
Packages.Table (Pkg).Decl.Packages := New_Pkg;
else
The_New_Package.Next :=
Projects.Table (Project).Decl.Packages;
Projects.Table (Project).Decl.Packages := New_Pkg;
end if;
Packages.Table (New_Pkg) := The_New_Package;
if Project_Of_Renamed_Package /= Empty_Node then
declare
Project_Name : constant Name_Id :=
Name_Of
(Project_Of_Renamed_Package);
Renamed_Project : constant Project_Id :=
Imported_Or_Extended_Project_From
(Project, Project_Name);
Renamed_Package : constant Package_Id :=
Package_From
(Renamed_Project,
Name_Of (Current_Item));
begin
Packages.Table (New_Pkg).Decl :=
Packages.Table (Renamed_Package).Decl;
end;
else
Add_Attributes
(Project,
Packages.Table (New_Pkg).Decl,
Package_Attributes.Table
(Package_Id_Of (Current_Item)).First_Attribute);
Process_Declarative_Items
(Project => Project,
From_Project_Node => From_Project_Node,
Pkg => New_Pkg,
Item => First_Declarative_Item_Of
(Current_Item));
end if;
end;
end if;
when N_String_Type_Declaration =>
null;
when N_Attribute_Declaration |
N_Typed_Variable_Declaration |
N_Variable_Declaration =>
if Expression_Of (Current_Item) = Empty_Node then
declare
Current_Item_Name : constant Name_Id :=
Name_Of (Current_Item);
New_Array : Array_Id;
Orig_Array : Array_Id;
Orig_Project_Name : Name_Id := No_Name;
Orig_Project : Project_Id := No_Project;
Orig_Package_Name : Name_Id := No_Name;
Orig_Package : Package_Id := No_Package;
New_Element : Array_Element_Id := No_Array_Element;
Prev_Element : Array_Element_Id := No_Array_Element;
Orig_Element : Array_Element_Id := No_Array_Element;
Next_Element : Array_Element_Id := No_Array_Element;
begin
if Pkg /= No_Package then
New_Array := Packages.Table (Pkg).Decl.Arrays;
else
New_Array := Projects.Table (Project).Decl.Arrays;
end if;
while New_Array /= No_Array and then
Arrays.Table (New_Array).Name /= Current_Item_Name
loop
New_Array := Arrays.Table (New_Array).Next;
end loop;
if New_Array = No_Array then
Arrays.Increment_Last;
New_Array := Arrays.Last;
if Pkg /= No_Package then
Arrays.Table (New_Array) :=
(Name => Current_Item_Name,
Value => No_Array_Element,
Next => Packages.Table (Pkg).Decl.Arrays);
Packages.Table (Pkg).Decl.Arrays := New_Array;
else
Arrays.Table (New_Array) :=
(Name => Current_Item_Name,
Value => No_Array_Element,
Next => Projects.Table (Project).Decl.Arrays);
Projects.Table (Project).Decl.Arrays := New_Array;
end if;
end if;
Orig_Project_Name :=
Name_Of (Associative_Project_Of (Current_Item));
for Index in Projects.First .. Projects.Last loop
if Projects.Table (Index).Name = Orig_Project_Name then
Orig_Project := Index;
exit;
end if;
end loop;
pragma Assert (Orig_Project /= No_Project,
"original project not found");
if Associative_Package_Of (Current_Item) = Empty_Node then
Orig_Array :=
Projects.Table (Orig_Project).Decl.Arrays;
else
Orig_Package_Name :=
Name_Of (Associative_Package_Of (Current_Item));
Orig_Package :=
Projects.Table (Orig_Project).Decl.Packages;
pragma Assert (Orig_Package /= No_Package,
"original package not found");
while Packages.Table (Orig_Package).Name /=
Orig_Package_Name
loop
Orig_Package := Packages.Table (Orig_Package).Next;
pragma Assert (Orig_Package /= No_Package,
"original package not found");
end loop;
Orig_Array :=
Packages.Table (Orig_Package).Decl.Arrays;
end if;
while Orig_Array /= No_Array and then
Arrays.Table (Orig_Array).Name /= Current_Item_Name
loop
Orig_Array := Arrays.Table (Orig_Array).Next;
end loop;
if Orig_Array = No_Array then
if Error_Report = null then
Error_Msg
("associative array value cannot be found",
Location_Of (Current_Item));
else
Error_Report
("associative array value cannot be found",
Project);
end if;
else
Orig_Element := Arrays.Table (Orig_Array).Value;
while Orig_Element /= No_Array_Element loop
if Prev_Element = No_Array_Element then
if Arrays.Table (New_Array).Value =
No_Array_Element
then
Array_Elements.Increment_Last;
New_Element := Array_Elements.Last;
Arrays.Table (New_Array).Value := New_Element;
Next_Element := No_Array_Element;
else
New_Element := Arrays.Table (New_Array).Value;
Next_Element :=
Array_Elements.Table (New_Element).Next;
end if;
else
Next_Element :=
Array_Elements.Table (Prev_Element).Next;
if Next_Element = No_Array_Element then
Array_Elements.Increment_Last;
New_Element := Array_Elements.Last;
else
New_Element := Next_Element;
Next_Element :=
Array_Elements.Table (New_Element).Next;
end if;
end if;
Array_Elements.Table (New_Element) :=
Array_Elements.Table (Orig_Element);
Array_Elements.Table (New_Element).Value.Project :=
Project;
Array_Elements.Table (New_Element).Next :=
Next_Element;
Prev_Element := New_Element;
Orig_Element :=
Array_Elements.Table (Orig_Element).Next;
end loop;
Array_Elements.Table (New_Element).Next :=
No_Array_Element;
end if;
end;
else
declare
New_Value : constant Variable_Value :=
Expression
(Project => Project,
From_Project_Node => From_Project_Node,
Pkg => Pkg,
First_Term =>
Tree.First_Term (Expression_Of
(Current_Item)),
Kind =>
Expression_Kind_Of (Current_Item));
The_Variable : Variable_Id := No_Variable;
Current_Item_Name : constant Name_Id :=
Name_Of (Current_Item);
begin
if
Kind_Of (Current_Item) = N_Typed_Variable_Declaration
then
if New_Value.Value = Empty_String then
Error_Msg_Name_1 := Name_Of (Current_Item);
if Error_Report = null then
Error_Msg
("no value defined for %",
Location_Of (Current_Item));
else
Error_Report
("no value defined for " &
Get_Name_String (Error_Msg_Name_1),
Project);
end if;
else
declare
Current_String : Project_Node_Id :=
First_Literal_String
(String_Type_Of
(Current_Item));
begin
while Current_String /= Empty_Node
and then String_Value_Of (Current_String) /=
New_Value.Value
loop
Current_String :=
Next_Literal_String (Current_String);
end loop;
if Current_String = Empty_Node then
Error_Msg_Name_1 := New_Value.Value;
Error_Msg_Name_2 := Name_Of (Current_Item);
if Error_Report = null then
Error_Msg
("value { is illegal for typed string %",
Location_Of (Current_Item));
else
Error_Report
("value """ &
Get_Name_String (Error_Msg_Name_1) &
""" is illegal for typed string """ &
Get_Name_String (Error_Msg_Name_2) &
"""",
Project);
end if;
end if;
end;
end if;
end if;
if Kind_Of (Current_Item) /= N_Attribute_Declaration
or else
Associative_Array_Index_Of (Current_Item) = No_Name
then
if
Kind_Of (Current_Item) = N_Attribute_Declaration
then
if Pkg /= No_Package then
The_Variable :=
Packages.Table (Pkg).Decl.Attributes;
else
The_Variable :=
Projects.Table (Project).Decl.Attributes;
end if;
else
if Pkg /= No_Package then
The_Variable :=
Packages.Table (Pkg).Decl.Variables;
else
The_Variable :=
Projects.Table (Project).Decl.Variables;
end if;
end if;
while
The_Variable /= No_Variable
and then
Variable_Elements.Table (The_Variable).Name /=
Current_Item_Name
loop
The_Variable :=
Variable_Elements.Table (The_Variable).Next;
end loop;
if The_Variable = No_Variable then
pragma Assert
(Kind_Of (Current_Item) /=
N_Attribute_Declaration,
"illegal attribute declaration");
Variable_Elements.Increment_Last;
The_Variable := Variable_Elements.Last;
if Pkg /= No_Package then
Variable_Elements.Table (The_Variable) :=
(Next =>
Packages.Table (Pkg).Decl.Variables,
Name => Current_Item_Name,
Value => New_Value);
Packages.Table (Pkg).Decl.Variables :=
The_Variable;
else
Variable_Elements.Table (The_Variable) :=
(Next =>
Projects.Table (Project).Decl.Variables,
Name => Current_Item_Name,
Value => New_Value);
Projects.Table (Project).Decl.Variables :=
The_Variable;
end if;
else
Variable_Elements.Table (The_Variable).Value :=
New_Value;
end if;
else
Get_Name_String
(Associative_Array_Index_Of (Current_Item));
if Case_Insensitive (Current_Item) then
GNAT.Case_Util.To_Lower
(Name_Buffer (1 .. Name_Len));
end if;
declare
The_Array : Array_Id;
The_Array_Element : Array_Element_Id :=
No_Array_Element;
Index_Name : constant Name_Id := Name_Find;
begin
if Pkg /= No_Package then
The_Array := Packages.Table (Pkg).Decl.Arrays;
else
The_Array := Projects.Table
(Project).Decl.Arrays;
end if;
while
The_Array /= No_Array
and then Arrays.Table (The_Array).Name /=
Current_Item_Name
loop
The_Array := Arrays.Table (The_Array).Next;
end loop;
if The_Array = No_Array then
Arrays.Increment_Last;
The_Array := Arrays.Last;
if Pkg /= No_Package then
Arrays.Table (The_Array) :=
(Name => Current_Item_Name,
Value => No_Array_Element,
Next => Packages.Table (Pkg).Decl.Arrays);
Packages.Table (Pkg).Decl.Arrays := The_Array;
else
Arrays.Table (The_Array) :=
(Name => Current_Item_Name,
Value => No_Array_Element,
Next =>
Projects.Table (Project).Decl.Arrays);
Projects.Table (Project).Decl.Arrays :=
The_Array;
end if;
else
The_Array_Element :=
Arrays.Table (The_Array).Value;
end if;
while The_Array_Element /= No_Array_Element
and then
Array_Elements.Table (The_Array_Element).Index /=
Index_Name
loop
The_Array_Element :=
Array_Elements.Table (The_Array_Element).Next;
end loop;
if The_Array_Element = No_Array_Element then
Array_Elements.Increment_Last;
The_Array_Element := Array_Elements.Last;
Array_Elements.Table (The_Array_Element) :=
(Index => Index_Name,
Src_Index => Source_Index_Of (Current_Item),
Index_Case_Sensitive =>
not Case_Insensitive (Current_Item),
Value => New_Value,
Next => Arrays.Table (The_Array).Value);
Arrays.Table (The_Array).Value :=
The_Array_Element;
else
Array_Elements.Table (The_Array_Element).Value :=
New_Value;
end if;
end;
end if;
end;
end if;
when N_Case_Construction =>
declare
The_Project : Project_Id := Project;
The_Package : Package_Id := Pkg;
The_Variable : Variable_Value := Nil_Variable_Value;
Case_Value : Name_Id := No_Name;
Case_Item : Project_Node_Id := Empty_Node;
Choice_String : Project_Node_Id := Empty_Node;
Decl_Item : Project_Node_Id := Empty_Node;
begin
declare
Variable_Node : constant Project_Node_Id :=
Case_Variable_Reference_Of
(Current_Item);
Var_Id : Variable_Id := No_Variable;
Name : Name_Id := No_Name;
begin
if Project_Node_Of (Variable_Node) /= Empty_Node then
Name := Name_Of (Project_Node_Of (Variable_Node));
The_Project :=
Imported_Or_Extended_Project_From (Project, Name);
end if;
if Package_Node_Of (Variable_Node) /= Empty_Node then
Name := Name_Of (Package_Node_Of (Variable_Node));
The_Package := Package_From (The_Project, Name);
end if;
Name := Name_Of (Variable_Node);
if The_Package /= No_Package then
Var_Id := Packages.Table (The_Package).Decl.Variables;
Name := Name_Of (Variable_Node);
while Var_Id /= No_Variable
and then
Variable_Elements.Table (Var_Id).Name /= Name
loop
Var_Id := Variable_Elements.Table (Var_Id).Next;
end loop;
end if;
if Var_Id = No_Variable
and then Package_Node_Of (Variable_Node) = Empty_Node
then
Var_Id := Projects.Table (The_Project).Decl.Variables;
while Var_Id /= No_Variable
and then
Variable_Elements.Table (Var_Id).Name /= Name
loop
Var_Id := Variable_Elements.Table (Var_Id).Next;
end loop;
end if;
if Var_Id = No_Variable then
Write_Line ("variable """ &
Get_Name_String (Name) &
""" not found");
raise Program_Error;
end if;
The_Variable := Variable_Elements.Table (Var_Id).Value;
if The_Variable.Kind /= Single then
Write_Line ("variable""" &
Get_Name_String (Name) &
""" is not a single string variable");
raise Program_Error;
end if;
Case_Value := The_Variable.Value;
end;
Case_Item := First_Case_Item_Of (Current_Item);
Case_Item_Loop :
while Case_Item /= Empty_Node loop
Choice_String := First_Choice_Of (Case_Item);
if Choice_String = Empty_Node then
Decl_Item := First_Declarative_Item_Of (Case_Item);
exit Case_Item_Loop;
end if;
Choice_Loop :
while Choice_String /= Empty_Node loop
if
Case_Value = String_Value_Of (Choice_String)
then
Decl_Item :=
First_Declarative_Item_Of (Case_Item);
exit Case_Item_Loop;
end if;
Choice_String :=
Next_Literal_String (Choice_String);
end loop Choice_Loop;
Case_Item := Next_Case_Item (Case_Item);
end loop Case_Item_Loop;
if Decl_Item /= Empty_Node then
Process_Declarative_Items
(Project => Project,
From_Project_Node => From_Project_Node,
Pkg => Pkg,
Item => Decl_Item);
end if;
end;
when others =>
Write_Line ("Illegal declarative item: " &
Project_Node_Kind'Image (Kind_Of (Current_Item)));
raise Program_Error;
end case;
end loop;
end Process_Declarative_Items;
procedure Recursive_Check
(Project : Project_Id;
Process_Languages : Languages_Processed;
Follow_Links : Boolean)
is
Data : Project_Data;
Imported_Project_List : Project_List := Empty_Project_List;
begin
if Project /= No_Project
and then not Projects.Table (Project).Checked
then
Projects.Table (Project).Checked := True;
Data := Projects.Table (Project);
Recursive_Check (Data.Extends, Process_Languages, Follow_Links);
Imported_Project_List := Data.Imported_Projects;
while Imported_Project_List /= Empty_Project_List loop
Recursive_Check
(Project_Lists.Table (Imported_Project_List).Project,
Process_Languages, Follow_Links);
Imported_Project_List :=
Project_Lists.Table (Imported_Project_List).Next;
end loop;
if Opt.Verbose_Mode then
Write_Str ("Checking project file """);
Write_Str (Get_Name_String (Data.Name));
Write_Line ("""");
end if;
case Process_Languages is
when Ada_Language =>
Prj.Nmsc.Ada_Check (Project, Error_Report, Follow_Links);
when Other_Languages =>
Prj.Nmsc.Other_Languages_Check (Project, Error_Report);
end case;
end if;
end Recursive_Check;
procedure Recursive_Process
(Project : out Project_Id;
From_Project_Node : Project_Node_Id;
Extended_By : Project_Id)
is
With_Clause : Project_Node_Id;
begin
if From_Project_Node = Empty_Node then
Project := No_Project;
else
declare
Processed_Data : Project_Data := Empty_Project;
Imported : Project_List := Empty_Project_List;
Declaration_Node : Project_Node_Id := Empty_Node;
Name : constant Name_Id := Name_Of (From_Project_Node);
begin
Project := Processed_Projects.Get (Name);
if Project /= No_Project then
return;
end if;
Projects.Increment_Last;
Project := Projects.Last;
Processed_Projects.Set (Name, Project);
Processed_Data.Name := Name;
Get_Name_String (Name);
if Name_Len > Virtual_Prefix'Length
and then Name_Buffer (1 .. Virtual_Prefix'Length) =
Virtual_Prefix
then
Processed_Data.Virtual := True;
end if;
Processed_Data.Display_Path_Name :=
Path_Name_Of (From_Project_Node);
Get_Name_String (Processed_Data.Display_Path_Name);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Processed_Data.Path_Name := Name_Find;
Processed_Data.Location := Location_Of (From_Project_Node);
Processed_Data.Display_Directory :=
Directory_Of (From_Project_Node);
Get_Name_String (Processed_Data.Display_Directory);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Processed_Data.Directory := Name_Find;
Processed_Data.Extended_By := Extended_By;
Processed_Data.Naming := Standard_Naming_Data;
Add_Attributes (Project, Processed_Data.Decl, Attribute_First);
With_Clause := First_With_Clause_Of (From_Project_Node);
while With_Clause /= Empty_Node loop
declare
New_Project : Project_Id;
New_Data : Project_Data;
begin
Recursive_Process
(Project => New_Project,
From_Project_Node => Project_Node_Of (With_Clause),
Extended_By => No_Project);
New_Data := Projects.Table (New_Project);
if New_Data.First_Referred_By = No_Project then
New_Data.First_Referred_By := Project;
Projects.Table (New_Project) := New_Data;
end if;
Project_Lists.Increment_Last;
Project_Lists.Table (Project_Lists.Last) :=
(Project => New_Project, Next => Empty_Project_List);
if Imported = Empty_Project_List then
Processed_Data.Imported_Projects := Project_Lists.Last;
else
Project_Lists.Table (Imported).Next := Project_Lists.Last;
end if;
Imported := Project_Lists.Last;
With_Clause := Next_With_Clause_Of (With_Clause);
end;
end loop;
Declaration_Node := Project_Declaration_Of (From_Project_Node);
Recursive_Process
(Project => Processed_Data.Extends,
From_Project_Node => Extended_Project_Of (Declaration_Node),
Extended_By => Project);
Projects.Table (Project) := Processed_Data;
Process_Declarative_Items
(Project => Project,
From_Project_Node => From_Project_Node,
Pkg => No_Package,
Item => First_Declarative_Item_Of
(Declaration_Node));
if Processed_Data.Extends /= No_Project then
Processed_Data := Projects.Table (Project);
declare
Extended_Pkg : Package_Id :=
Projects.Table
(Processed_Data.Extends).Decl.Packages;
Current_Pkg : Package_Id;
Element : Package_Element;
First : constant Package_Id :=
Processed_Data.Decl.Packages;
Attribute1 : Variable_Id;
Attribute2 : Variable_Id;
Attr_Value1 : Variable;
Attr_Value2 : Variable;
begin
while Extended_Pkg /= No_Package loop
Element := Packages.Table (Extended_Pkg);
Current_Pkg := First;
loop
exit when Current_Pkg = No_Package
or else Packages.Table (Current_Pkg).Name
= Element.Name;
Current_Pkg := Packages.Table (Current_Pkg).Next;
end loop;
if Current_Pkg = No_Package then
Packages.Increment_Last;
Current_Pkg := Packages.Last;
Packages.Table (Current_Pkg) :=
(Name => Element.Name,
Decl => Element.Decl,
Parent => No_Package,
Next => Processed_Data.Decl.Packages);
Processed_Data.Decl.Packages := Current_Pkg;
end if;
Extended_Pkg := Element.Next;
end loop;
Attribute1 := Processed_Data.Decl.Attributes;
while Attribute1 /= No_Variable loop
Attr_Value1 := Variable_Elements.Table (Attribute1);
exit when Attr_Value1.Name = Snames.Name_Languages;
Attribute1 := Attr_Value1.Next;
end loop;
if Attribute1 = No_Variable or else
Attr_Value1.Value.Default
then
Attribute2 :=
Projects.Table (Processed_Data.Extends).Decl.Attributes;
while Attribute2 /= No_Variable loop
Attr_Value2 := Variable_Elements.Table (Attribute2);
exit when Attr_Value2.Name = Snames.Name_Languages;
Attribute2 := Attr_Value2.Next;
end loop;
if Attribute2 /= No_Variable and then
not Attr_Value2.Value.Default
then
if Attribute1 = No_Variable then
Variable_Elements.Increment_Last;
Attribute1 := Variable_Elements.Last;
Attr_Value1.Next := Processed_Data.Decl.Attributes;
Processed_Data.Decl.Attributes := Attribute1;
end if;
Attr_Value1.Name := Snames.Name_Languages;
Attr_Value1.Value := Attr_Value2.Value;
Variable_Elements.Table (Attribute1) := Attr_Value1;
end if;
end if;
end;
Projects.Table (Project) := Processed_Data;
end if;
end;
end if;
end Recursive_Process;
end Prj.Proc;