45d04cbb92
* sem_ch12.adb (Instantiate_Package_Body): if instance is a compilation unit, always replace instance node with new body, for ASIS use. * prj-nmsc.adb (Language_Independent_Check): Issue a warning if libraries are not supported and both attributes Library_Name and Library_Dir are specified. * prj-proc.adb (Expression): Set location of Result to location of first term. * Makefile.in: Add mlib.o, mlib-fil.o, mlib-tgt and mlib-utl to GNATLS. (prj-nmsc is now importing MLib.Tgt) * prj-proc.adb: Put the change indicated above that was forgotten. From-SVN: r47690
1375 lines
50 KiB
Ada
1375 lines
50 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT COMPILER COMPONENTS --
|
|
-- --
|
|
-- P R J . P R O C --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- $Revision$
|
|
-- --
|
|
-- Copyright (C) 2001 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- --
|
|
-- ware Foundation; either version 2, or (at your option) any later ver- --
|
|
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
|
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
|
|
-- for more details. You should have received a copy of the GNU General --
|
|
-- Public License distributed with GNAT; see file COPYING. If not, write --
|
|
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
|
|
-- MA 02111-1307, USA. --
|
|
-- --
|
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
|
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
with Errout; use Errout;
|
|
with Namet; use Namet;
|
|
with Opt;
|
|
with Output; use Output;
|
|
with Prj.Attr; use Prj.Attr;
|
|
with Prj.Com; use Prj.Com;
|
|
with Prj.Ext; use Prj.Ext;
|
|
with Prj.Nmsc; use Prj.Nmsc;
|
|
with Stringt; use Stringt;
|
|
|
|
with 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 => "=");
|
|
-- This hash table contains all processed projects
|
|
|
|
procedure Add (To_Exp : in out String_Id; Str : String_Id);
|
|
-- Concatenate two strings and returns another string if both
|
|
-- arguments are not null string.
|
|
|
|
procedure Add_Attributes
|
|
(Decl : in out Declarations;
|
|
First : Attribute_Node_Id);
|
|
-- Add all attributes, starting with First, with their default
|
|
-- values to the package or project with declarations Decl.
|
|
|
|
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;
|
|
-- From N_Expression project node From_Project_Node, compute the value
|
|
-- of an expression and return it as a Variable_Value.
|
|
|
|
function Imported_Or_Modified_Project_From
|
|
(Project : Project_Id;
|
|
With_Name : Name_Id)
|
|
return Project_Id;
|
|
-- Find an imported or modified project of Project whose name is With_Name.
|
|
|
|
function Package_From
|
|
(Project : Project_Id;
|
|
With_Name : Name_Id)
|
|
return Package_Id;
|
|
-- Find the package of Project whose name is With_Name.
|
|
|
|
procedure Process_Declarative_Items
|
|
(Project : Project_Id;
|
|
From_Project_Node : Project_Node_Id;
|
|
Pkg : Package_Id;
|
|
Item : Project_Node_Id);
|
|
-- Process declarative items starting with From_Project_Node, and put them
|
|
-- in declarations Decl. This is a recursive procedure; it calls itself for
|
|
-- a package declaration or a case construction.
|
|
|
|
procedure Recursive_Process
|
|
(Project : out Project_Id;
|
|
From_Project_Node : Project_Node_Id;
|
|
Modified_By : Project_Id);
|
|
-- Process project with node From_Project_Node in the tree.
|
|
-- Do nothing if From_Project_Node is Empty_Node.
|
|
-- If project has already been processed, simply return its project id.
|
|
-- Otherwise create a new project id, mark it as processed, call itself
|
|
-- recursively for all imported projects and a modified project, if any.
|
|
-- Then process the declarative items of the project.
|
|
|
|
procedure Check (Project : in out Project_Id);
|
|
-- Set all projects to not checked, then call Recursive_Check for
|
|
-- the main project Project.
|
|
-- Project is set to No_Project if errors occurred.
|
|
|
|
procedure Recursive_Check (Project : Project_Id);
|
|
-- If Project is marked as not checked, mark it as checked,
|
|
-- call Check_Naming_Scheme for the project, then call itself
|
|
-- for a possible modified project and all the imported projects
|
|
-- of Project.
|
|
|
|
---------
|
|
-- Add --
|
|
---------
|
|
|
|
procedure Add (To_Exp : in out String_Id; Str : String_Id) is
|
|
begin
|
|
if To_Exp = Types.No_String or else String_Length (To_Exp) = 0 then
|
|
|
|
-- To_Exp is nil or empty. The result is Str.
|
|
|
|
To_Exp := Str;
|
|
|
|
-- If Str is nil, then do not change To_Ext
|
|
|
|
elsif Str /= No_String then
|
|
Start_String (To_Exp);
|
|
Store_String_Chars (Str);
|
|
To_Exp := End_String;
|
|
end if;
|
|
end Add;
|
|
|
|
--------------------
|
|
-- Add_Attributes --
|
|
--------------------
|
|
|
|
procedure Add_Attributes
|
|
(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 /= Associative_Array then
|
|
declare
|
|
New_Attribute : Variable_Value;
|
|
|
|
begin
|
|
case Attribute_Data.Kind_1 is
|
|
|
|
-- Undefined should not happen
|
|
|
|
when Undefined =>
|
|
pragma Assert
|
|
(False, "attribute with an undefined kind");
|
|
raise Program_Error;
|
|
|
|
-- Single attributes have a default value of empty string
|
|
|
|
when Single =>
|
|
New_Attribute :=
|
|
(Kind => Single,
|
|
Location => No_Location,
|
|
Default => True,
|
|
Value => Empty_String);
|
|
|
|
-- List attributes have a default value of nil list
|
|
|
|
when List =>
|
|
New_Attribute :=
|
|
(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;
|
|
|
|
-----------
|
|
-- Check --
|
|
-----------
|
|
|
|
procedure Check (Project : in out Project_Id) is
|
|
begin
|
|
-- Make sure that all projects are marked as not checked.
|
|
|
|
for Index in 1 .. Projects.Last loop
|
|
Projects.Table (Index).Checked := False;
|
|
end loop;
|
|
|
|
Recursive_Check (Project);
|
|
|
|
if Errout.Errors_Detected > 0 then
|
|
Project := No_Project;
|
|
end if;
|
|
|
|
end Check;
|
|
|
|
----------------
|
|
-- Expression --
|
|
----------------
|
|
|
|
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 term in the expression list
|
|
|
|
The_Current_Term : Project_Node_Id := Empty_Node;
|
|
-- The current term node id
|
|
|
|
Term_Kind : Variable_Kind;
|
|
-- The kind of the current term
|
|
|
|
Result : Variable_Value (Kind => Kind);
|
|
-- The returned result
|
|
|
|
Last : String_List_Id := Nil_String;
|
|
-- Reference to the last string elements in Result, when Kind is List.
|
|
|
|
begin
|
|
Result.Location := Location_Of (First_Term);
|
|
|
|
-- Process each term of the expression, starting with First_Term
|
|
|
|
while The_Term /= Empty_Node loop
|
|
|
|
-- We get the term data and kind ...
|
|
|
|
Term_Kind := Expression_Kind_Of (The_Term);
|
|
|
|
The_Current_Term := Current_Term (The_Term);
|
|
|
|
case Kind_Of (The_Current_Term) is
|
|
|
|
when N_Literal_String =>
|
|
|
|
case Kind is
|
|
|
|
when Undefined =>
|
|
|
|
-- Should never happen
|
|
|
|
pragma Assert (False, "Undefined expression kind");
|
|
raise Program_Error;
|
|
|
|
when Single =>
|
|
Add (Result.Value, String_Value_Of (The_Current_Term));
|
|
|
|
when List =>
|
|
|
|
String_Elements.Increment_Last;
|
|
|
|
if Last = Nil_String then
|
|
|
|
-- This can happen in an expression such as
|
|
-- () & "toto"
|
|
|
|
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),
|
|
Location => Location_Of (The_Current_Term),
|
|
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
|
|
|
|
-- If String_Node is nil, it is an empty list,
|
|
-- there is nothing to do
|
|
|
|
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
|
|
|
|
-- This literal string list is the first term
|
|
-- in a string list expression
|
|
|
|
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,
|
|
Location => Value.Location,
|
|
Next => Nil_String);
|
|
|
|
loop
|
|
-- Add the other element of the literal string list
|
|
-- one after the other
|
|
|
|
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,
|
|
Location => Value.Location,
|
|
Next => Nil_String);
|
|
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;
|
|
Term_Project : constant Project_Node_Id :=
|
|
Project_Node_Of (The_Current_Term);
|
|
Term_Package : constant Project_Node_Id :=
|
|
Package_Node_Of (The_Current_Term);
|
|
|
|
begin
|
|
if Term_Project /= Empty_Node and then
|
|
Term_Project /= From_Project_Node
|
|
then
|
|
-- This variable or attribute comes from another project
|
|
|
|
The_Name := Name_Of (Term_Project);
|
|
The_Project := Imported_Or_Modified_Project_From
|
|
(Project => Project, With_Name => The_Name);
|
|
end if;
|
|
|
|
if Term_Package /= Empty_Node then
|
|
|
|
-- This is an attribute of a package
|
|
|
|
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 The_Package /= No_Package then
|
|
|
|
-- First, if there is a package, look into the package
|
|
|
|
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 we have not found it, look into the project
|
|
|
|
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);
|
|
|
|
case Kind is
|
|
|
|
when Undefined =>
|
|
|
|
-- Should never happen
|
|
|
|
pragma Assert (False, "undefined expression kind");
|
|
null;
|
|
|
|
when Single =>
|
|
|
|
case The_Variable.Value.Kind is
|
|
|
|
when Undefined =>
|
|
null;
|
|
|
|
when Single =>
|
|
Add (Result.Value, The_Variable.Value.Value);
|
|
|
|
when List =>
|
|
|
|
-- Should never happen
|
|
|
|
pragma Assert
|
|
(False,
|
|
"list cannot appear in single " &
|
|
"string expression");
|
|
null;
|
|
|
|
end case;
|
|
|
|
when List =>
|
|
case The_Variable.Value.Kind is
|
|
|
|
when Undefined =>
|
|
null;
|
|
|
|
when Single =>
|
|
String_Elements.Increment_Last;
|
|
|
|
if Last = Nil_String then
|
|
|
|
-- This can happen in an expression such as
|
|
-- () & Var
|
|
|
|
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.Value,
|
|
Location => Location_Of (The_Current_Term),
|
|
Next => Nil_String);
|
|
|
|
when List =>
|
|
|
|
declare
|
|
The_List : String_List_Id :=
|
|
The_Variable.Value.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,
|
|
Location => Location_Of
|
|
(The_Current_Term),
|
|
Next => Nil_String);
|
|
The_List :=
|
|
String_Elements.Table (The_List).Next;
|
|
|
|
end loop;
|
|
end;
|
|
end case;
|
|
end case;
|
|
end;
|
|
|
|
when N_External_Value =>
|
|
String_To_Name_Buffer
|
|
(String_Value_Of (External_Reference_Of (The_Current_Term)));
|
|
|
|
declare
|
|
Name : constant Name_Id := Name_Find;
|
|
Default : String_Id := No_String;
|
|
Value : String_Id := No_String;
|
|
|
|
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_String then
|
|
if Error_Report = null then
|
|
Error_Msg
|
|
("undefined external reference",
|
|
Location_Of (The_Current_Term));
|
|
|
|
else
|
|
Error_Report
|
|
("""" & Get_Name_String (Name) &
|
|
""" is an undefined external reference");
|
|
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,
|
|
Location => Location_Of (The_Current_Term),
|
|
Next => Nil_String);
|
|
|
|
end case;
|
|
|
|
end;
|
|
|
|
when others =>
|
|
|
|
-- Should never happen
|
|
|
|
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;
|
|
|
|
---------------------------------------
|
|
-- Imported_Or_Modified_Project_From --
|
|
---------------------------------------
|
|
|
|
function Imported_Or_Modified_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
|
|
-- First check if it is the name of a modified project
|
|
|
|
if Data.Modifies /= No_Project
|
|
and then Projects.Table (Data.Modifies).Name = With_Name
|
|
then
|
|
return Data.Modifies;
|
|
|
|
else
|
|
-- Then check the name of each imported project
|
|
|
|
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_Modified_Project_From;
|
|
|
|
------------------
|
|
-- Package_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
|
|
-- Check the name of each existing package of Project
|
|
|
|
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
|
|
-- Should never happen
|
|
Write_Line ("package """ & Get_Name_String (With_Name) &
|
|
""" not found");
|
|
raise Program_Error;
|
|
|
|
else
|
|
return Result;
|
|
end if;
|
|
end Package_From;
|
|
|
|
-------------
|
|
-- Process --
|
|
-------------
|
|
|
|
procedure Process
|
|
(Project : out Project_Id;
|
|
From_Project_Node : Project_Node_Id;
|
|
Report_Error : Put_Line_Access)
|
|
is
|
|
begin
|
|
Error_Report := Report_Error;
|
|
|
|
-- Make sure there is no projects in the data structure
|
|
|
|
Projects.Set_Last (No_Project);
|
|
Processed_Projects.Reset;
|
|
|
|
-- And process the main project and all of the projects it depends on,
|
|
-- recursively
|
|
|
|
Recursive_Process
|
|
(Project => Project,
|
|
From_Project_Node => From_Project_Node,
|
|
Modified_By => No_Project);
|
|
|
|
if Errout.Errors_Detected > 0 then
|
|
Project := No_Project;
|
|
end if;
|
|
|
|
if Project /= No_Project then
|
|
Check (Project);
|
|
end if;
|
|
|
|
end Process;
|
|
|
|
-------------------------------
|
|
-- Process_Declarative_Items --
|
|
-------------------------------
|
|
|
|
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
|
|
-- For each declarative item
|
|
|
|
while Current_Declarative_Item /= Empty_Node loop
|
|
|
|
-- Get its data
|
|
|
|
Current_Item := Current_Item_Node (Current_Declarative_Item);
|
|
|
|
-- And set Current_Declarative_Item to the next declarative item
|
|
-- ready for the next iteration
|
|
|
|
Current_Declarative_Item := Next_Declarative_Item
|
|
(Current_Declarative_Item);
|
|
|
|
case Kind_Of (Current_Item) is
|
|
|
|
when N_Package_Declaration =>
|
|
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
|
|
|
|
-- Renamed package
|
|
|
|
declare
|
|
Project_Name : constant Name_Id :=
|
|
Name_Of
|
|
(Project_Of_Renamed_Package);
|
|
|
|
Renamed_Project : constant Project_Id :=
|
|
Imported_Or_Modified_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
|
|
-- Set the default values of the attributes
|
|
|
|
Add_Attributes
|
|
(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;
|
|
|
|
when N_String_Type_Declaration =>
|
|
|
|
-- There is nothing to process
|
|
|
|
null;
|
|
|
|
when N_Attribute_Declaration |
|
|
N_Typed_Variable_Declaration |
|
|
N_Variable_Declaration =>
|
|
|
|
pragma Assert (Expression_Of (Current_Item) /= Empty_Node,
|
|
"no expression for an object declaration");
|
|
|
|
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 String_Equal (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));
|
|
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 not String_Equal
|
|
(String_Value_Of (Current_String),
|
|
New_Value.Value)
|
|
loop
|
|
Current_String :=
|
|
Next_Literal_String (Current_String);
|
|
end loop;
|
|
|
|
if Current_String = Empty_Node then
|
|
String_To_Name_Buffer (New_Value.Value);
|
|
Error_Msg_Name_1 := Name_Find;
|
|
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) &
|
|
"""");
|
|
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_String
|
|
then
|
|
-- Usual case
|
|
|
|
-- Code below really needs more comments ???
|
|
|
|
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
|
|
-- Associative array attribute
|
|
|
|
String_To_Name_Buffer
|
|
(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,
|
|
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;
|
|
|
|
when N_Case_Construction =>
|
|
declare
|
|
The_Project : Project_Id := Project;
|
|
The_Package : Package_Id := Pkg;
|
|
The_Variable : Variable_Value := Nil_Variable_Value;
|
|
Case_Value : String_Id := No_String;
|
|
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_Modified_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
|
|
|
|
-- Should never happen
|
|
|
|
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
|
|
|
|
-- Should never happen
|
|
|
|
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 String_Equal (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 =>
|
|
|
|
-- Should never happen
|
|
|
|
Write_Line ("Illegal declarative item: " &
|
|
Project_Node_Kind'Image (Kind_Of (Current_Item)));
|
|
raise Program_Error;
|
|
end case;
|
|
end loop;
|
|
end Process_Declarative_Items;
|
|
|
|
---------------------
|
|
-- Recursive_Check --
|
|
---------------------
|
|
|
|
procedure Recursive_Check (Project : Project_Id) is
|
|
Data : Project_Data;
|
|
Imported_Project_List : Project_List := Empty_Project_List;
|
|
|
|
begin
|
|
-- Do nothing if Project is No_Project, or Project has already
|
|
-- been marked as checked.
|
|
|
|
if Project /= No_Project
|
|
and then not Projects.Table (Project).Checked
|
|
then
|
|
Data := Projects.Table (Project);
|
|
|
|
-- Call itself for a possible modified project.
|
|
-- (if there is no modified project, then nothing happens).
|
|
|
|
Recursive_Check (Data.Modifies);
|
|
|
|
-- Call itself for all imported projects
|
|
|
|
Imported_Project_List := Data.Imported_Projects;
|
|
while Imported_Project_List /= Empty_Project_List loop
|
|
Recursive_Check
|
|
(Project_Lists.Table (Imported_Project_List).Project);
|
|
Imported_Project_List :=
|
|
Project_Lists.Table (Imported_Project_List).Next;
|
|
end loop;
|
|
|
|
-- Mark project as checked
|
|
|
|
Projects.Table (Project).Checked := True;
|
|
|
|
if Opt.Verbose_Mode then
|
|
Write_Str ("Checking project file """);
|
|
Write_Str (Get_Name_String (Data.Name));
|
|
Write_Line ("""");
|
|
end if;
|
|
|
|
Prj.Nmsc.Ada_Check (Project, Error_Report);
|
|
end if;
|
|
end Recursive_Check;
|
|
|
|
-----------------------
|
|
-- Recursive_Process --
|
|
-----------------------
|
|
|
|
procedure Recursive_Process
|
|
(Project : out Project_Id;
|
|
From_Project_Node : Project_Node_Id;
|
|
Modified_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;
|
|
Processed_Data.Path_Name := Path_Name_Of (From_Project_Node);
|
|
Processed_Data.Location := Location_Of (From_Project_Node);
|
|
Processed_Data.Directory := Directory_Of (From_Project_Node);
|
|
Processed_Data.Modified_By := Modified_By;
|
|
Add_Attributes (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),
|
|
Modified_By => No_Project);
|
|
New_Data := Projects.Table (New_Project);
|
|
|
|
-- If we were the first project to import it,
|
|
-- set First_Referred_By to us.
|
|
|
|
if New_Data.First_Referred_By = No_Project then
|
|
New_Data.First_Referred_By := Project;
|
|
Projects.Table (New_Project) := New_Data;
|
|
end if;
|
|
|
|
-- Add this project to our list of imported projects
|
|
|
|
Project_Lists.Increment_Last;
|
|
Project_Lists.Table (Project_Lists.Last) :=
|
|
(Project => New_Project, Next => Empty_Project_List);
|
|
|
|
-- Imported is the id of the last imported project.
|
|
-- If it is nil, then this imported project is our first.
|
|
|
|
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.Modifies,
|
|
From_Project_Node => Modified_Project_Of (Declaration_Node),
|
|
Modified_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));
|
|
|
|
end;
|
|
end if;
|
|
end Recursive_Process;
|
|
|
|
end Prj.Proc;
|