-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2002 Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2009, 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- --
+-- ware Foundation; either version 3, 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. --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-with Errout; use Errout;
-with Namet; use Namet;
-with Opt;
+with Err_Vars; use Err_Vars;
+with Opt; use 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 Stringt; use Stringt;
+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,
Equal => "=");
-- This hash table contains all processed projects
- procedure Add (To_Exp : in out String_Id; Str : String_Id);
+ package Unit_Htable is new GNAT.HTable.Simple_HTable
+ (Header_Num => Header_Num,
+ Element => Source_Id,
+ No_Element => No_Source,
+ Key => Name_Id,
+ Hash => Hash,
+ Equal => "=");
+ -- This hash table contains all processed projects
+
+ procedure Add (To_Exp : in out Name_Id; Str : Name_Id);
-- Concatenate two strings and returns another string if both
-- arguments are not null string.
+ -- In the following procedures, we are expected to guess the meaning of
+ -- the parameters from their names, this is never a good idea, comments
+ -- should be added precisely defining every formal ???
+
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.
+ (Project : Project_Id;
+ Project_Name : Name_Id;
+ Project_Dir : Name_Id;
+ In_Tree : Project_Tree_Ref;
+ Decl : in out Declarations;
+ First : Attribute_Node_Id;
+ Project_Level : Boolean);
+ -- Add all attributes, starting with First, with their default values to
+ -- the package or project with declarations Decl.
+
+ procedure Check
+ (In_Tree : Project_Tree_Ref;
+ Project : Project_Id;
+ Flags : Processing_Flags);
+ -- Set all projects to not checked, then call Recursive_Check for the
+ -- main project Project. Project is set to No_Project if errors occurred.
+ -- Current_Dir is for optimization purposes, avoiding extra system calls.
+ -- If Allow_Duplicate_Basenames, then files with the same base names are
+ -- authorized within a project for source-based languages (never for unit
+ -- based languages)
+
+ procedure Copy_Package_Declarations
+ (From : Declarations;
+ To : in out Declarations;
+ New_Loc : Source_Ptr;
+ Naming_Restricted : Boolean;
+ In_Tree : Project_Tree_Ref);
+ -- Copy a package declaration From to To for a renamed package. Change the
+ -- locations of all the attributes to New_Loc. When Naming_Restricted is
+ -- True, do not copy attributes Body, Spec, Implementation and
+ -- Specification.
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;
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Flags : Processing_Flags;
+ From_Project_Node : Project_Node_Id;
+ From_Project_Node_Tree : Project_Node_Tree_Ref;
+ 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
+ function Imported_Or_Extended_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
+ With_Name : Name_Id) return Project_Id;
+ -- Find an imported or extended project of Project whose name is With_Name
function Package_From
(Project : Project_Id;
- With_Name : Name_Id)
- return Package_Id;
+ In_Tree : Project_Tree_Ref;
+ 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);
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Flags : Processing_Flags;
+ From_Project_Node : Project_Node_Id;
+ From_Project_Node_Tree : Project_Node_Tree_Ref;
+ 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.
+ (In_Tree : Project_Tree_Ref;
+ Project : out Project_Id;
+ Flags : Processing_Flags;
+ From_Project_Node : Project_Node_Id;
+ From_Project_Node_Tree : Project_Node_Tree_Ref;
+ Extended_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
+ -- extended project, if any. Then process the declarative items of the
+ -- project.
+
+ function Get_Attribute_Index
+ (Tree : Project_Node_Tree_Ref;
+ Attr : Project_Node_Id;
+ Index : Name_Id) return Name_Id;
+ -- Copy the index of the attribute into Name_Buffer, converting to lower
+ -- case if the attribute is case-insensitive.
---------
-- Add --
---------
- procedure Add (To_Exp : in out String_Id; Str : String_Id) is
+ procedure Add (To_Exp : in out Name_Id; Str : Name_Id) is
begin
- if To_Exp = Types.No_String or else String_Length (To_Exp) = 0 then
+ if To_Exp = No_Name or else To_Exp = Empty_String then
- -- To_Exp is nil or empty. The result is Str.
+ -- 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;
+ 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
- (Decl : in out Declarations;
- First : Attribute_Node_Id) is
+ (Project : Project_Id;
+ Project_Name : Name_Id;
+ Project_Dir : Name_Id;
+ In_Tree : Project_Tree_Ref;
+ Decl : in out Declarations;
+ First : Attribute_Node_Id;
+ Project_Level : Boolean)
+ 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
+ if Attribute_Kind_Of (The_Attribute) = Single then
declare
New_Attribute : Variable_Value;
begin
- case Attribute_Data.Kind_1 is
+ case Variable_Kind_Of (The_Attribute) is
-- Undefined should not happen
when Single =>
New_Attribute :=
- (Kind => Single,
+ (Project => Project,
+ Kind => Single,
Location => No_Location,
Default => True,
- Value => Empty_String);
+ Value => Empty_String,
+ Index => 0);
+
+ -- Special cases of <project>'Name and
+ -- <project>'Project_Dir.
+
+ if Project_Level then
+ if Attribute_Name_Of (The_Attribute) =
+ Snames.Name_Name
+ then
+ New_Attribute.Value := Project_Name;
+
+ elsif Attribute_Name_Of (The_Attribute) =
+ Snames.Name_Project_Dir
+ then
+ New_Attribute.Value := Project_Dir;
+ end if;
+ end if;
-- List attributes have a default value of nil list
when List =>
New_Attribute :=
- (Kind => List,
+ (Project => Project,
+ Kind => List,
Location => No_Location,
Default => True,
Values => Nil_String);
end case;
- Variable_Elements.Increment_Last;
- Variable_Elements.Table (Variable_Elements.Last) :=
+ Variable_Element_Table.Increment_Last
+ (In_Tree.Variable_Elements);
+ In_Tree.Variable_Elements.Table
+ (Variable_Element_Table.Last
+ (In_Tree.Variable_Elements)) :=
(Next => Decl.Attributes,
- Name => Attribute_Data.Name,
+ Name => Attribute_Name_Of (The_Attribute),
Value => New_Attribute);
- Decl.Attributes := Variable_Elements.Last;
+ Decl.Attributes := Variable_Element_Table.Last
+ (In_Tree.Variable_Elements);
end;
end if;
- The_Attribute := Attributes.Table (The_Attribute).Next;
+ The_Attribute := Next_Attribute (After => The_Attribute);
end loop;
-
end Add_Attributes;
-----------
-- Check --
-----------
- procedure Check (Project : in out Project_Id) is
+ procedure Check
+ (In_Tree : Project_Tree_Ref;
+ Project : Project_Id;
+ Flags : Processing_Flags)
+ is
begin
- -- Make sure that all projects are marked as not checked
+ Process_Naming_Scheme (In_Tree, Project, Flags);
+
+ -- Set the Other_Part field for the units
+
+ declare
+ Source1 : Source_Id;
+ Name : Name_Id;
+ Source2 : Source_Id;
+ Iter : Source_Iterator;
- for Index in 1 .. Projects.Last loop
- Projects.Table (Index).Checked := False;
+ begin
+ Unit_Htable.Reset;
+
+ Iter := For_Each_Source (In_Tree);
+ loop
+ Source1 := Prj.Element (Iter);
+ exit when Source1 = No_Source;
+
+ if Source1.Unit /= No_Unit_Index then
+ Name := Source1.Unit.Name;
+ Source2 := Unit_Htable.Get (Name);
+
+ if Source2 = No_Source then
+ Unit_Htable.Set (K => Name, E => Source1);
+ else
+ Unit_Htable.Remove (Name);
+ end if;
+ end if;
+
+ Next (Iter);
+ end loop;
+ end;
+ end Check;
+
+ -------------------------------
+ -- Copy_Package_Declarations --
+ -------------------------------
+
+ procedure Copy_Package_Declarations
+ (From : Declarations;
+ To : in out Declarations;
+ New_Loc : Source_Ptr;
+ Naming_Restricted : Boolean;
+ In_Tree : Project_Tree_Ref)
+ is
+ V1 : Variable_Id;
+ V2 : Variable_Id := No_Variable;
+ Var : Variable;
+ A1 : Array_Id;
+ A2 : Array_Id := No_Array;
+ Arr : Array_Data;
+ E1 : Array_Element_Id;
+ E2 : Array_Element_Id := No_Array_Element;
+ Elm : Array_Element;
+
+ begin
+ -- To avoid references in error messages to attribute declarations in
+ -- an original package that has been renamed, copy all the attribute
+ -- declarations of the package and change all locations to New_Loc,
+ -- the location of the renamed package.
+
+ -- First single attributes
+
+ V1 := From.Attributes;
+ while V1 /= No_Variable loop
+
+ -- Copy the attribute
+
+ Var := In_Tree.Variable_Elements.Table (V1);
+ V1 := Var.Next;
+
+ -- Remove the Next component
+
+ Var.Next := No_Variable;
+
+ -- Change the location to New_Loc
+
+ Var.Value.Location := New_Loc;
+ Variable_Element_Table.Increment_Last (In_Tree.Variable_Elements);
+
+ -- Put in new declaration
+
+ if To.Attributes = No_Variable then
+ To.Attributes :=
+ Variable_Element_Table.Last (In_Tree.Variable_Elements);
+ else
+ In_Tree.Variable_Elements.Table (V2).Next :=
+ Variable_Element_Table.Last (In_Tree.Variable_Elements);
+ end if;
+
+ V2 := Variable_Element_Table.Last (In_Tree.Variable_Elements);
+ In_Tree.Variable_Elements.Table (V2) := Var;
end loop;
- Recursive_Check (Project);
+ -- Then the associated array attributes
- if Errout.Total_Errors_Detected > 0 then
- Project := No_Project;
+ A1 := From.Arrays;
+ while A1 /= No_Array loop
+ Arr := In_Tree.Arrays.Table (A1);
+ A1 := Arr.Next;
+
+ if not Naming_Restricted or else
+ (Arr.Name /= Snames.Name_Body
+ and then Arr.Name /= Snames.Name_Spec
+ and then Arr.Name /= Snames.Name_Implementation
+ and then Arr.Name /= Snames.Name_Specification)
+ then
+ -- Remove the Next component
+
+ Arr.Next := No_Array;
+
+ Array_Table.Increment_Last (In_Tree.Arrays);
+
+ -- Create new Array declaration
+
+ if To.Arrays = No_Array then
+ To.Arrays := Array_Table.Last (In_Tree.Arrays);
+ else
+ In_Tree.Arrays.Table (A2).Next :=
+ Array_Table.Last (In_Tree.Arrays);
+ end if;
+
+ A2 := Array_Table.Last (In_Tree.Arrays);
+
+ -- Don't store the array as its first element has not been set yet
+
+ -- Copy the array elements of the array
+
+ E1 := Arr.Value;
+ Arr.Value := No_Array_Element;
+ while E1 /= No_Array_Element loop
+
+ -- Copy the array element
+
+ Elm := In_Tree.Array_Elements.Table (E1);
+ E1 := Elm.Next;
+
+ -- Remove the Next component
+
+ Elm.Next := No_Array_Element;
+
+ -- Change the location
+
+ Elm.Value.Location := New_Loc;
+ Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
+
+ -- Create new array element
+
+ if Arr.Value = No_Array_Element then
+ Arr.Value :=
+ Array_Element_Table.Last (In_Tree.Array_Elements);
+ else
+ In_Tree.Array_Elements.Table (E2).Next :=
+ Array_Element_Table.Last (In_Tree.Array_Elements);
+ end if;
+
+ E2 := Array_Element_Table.Last (In_Tree.Array_Elements);
+ In_Tree.Array_Elements.Table (E2) := Elm;
+ end loop;
+
+ -- Finally, store the new array
+
+ In_Tree.Arrays.Table (A2) := Arr;
+ end if;
+ end loop;
+ end Copy_Package_Declarations;
+
+ -------------------------
+ -- Get_Attribute_Index --
+ -------------------------
+
+ function Get_Attribute_Index
+ (Tree : Project_Node_Tree_Ref;
+ Attr : Project_Node_Id;
+ Index : Name_Id) return Name_Id
+ is
+ Lower : Boolean;
+
+ begin
+ Get_Name_String (Index);
+ Lower := Case_Insensitive (Attr, Tree);
+
+ -- The index is always case insensitive if it does not include any dot.
+ -- ??? Why not use the properties from prj-attr, simply, maybe because
+ -- we don't know whether we have a file as an index?
+
+ if not Lower then
+ Lower := True;
+
+ for J in 1 .. Name_Len loop
+ if Name_Buffer (J) = '.' then
+ Lower := False;
+ exit;
+ end if;
+ end loop;
end if;
- end Check;
+ if Lower then
+ To_Lower (Name_Buffer (1 .. Name_Len));
+ return Name_Find;
+ else
+ return Index;
+ end if;
+ end Get_Attribute_Index;
----------------
-- 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
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Flags : Processing_Flags;
+ From_Project_Node : Project_Node_Id;
+ From_Project_Node_Tree : Project_Node_Tree_Ref;
+ Pkg : Package_Id;
+ First_Term : Project_Node_Id;
+ Kind : Variable_Kind) return Variable_Value
is
- The_Term : Project_Node_Id := First_Term;
+ The_Term : Project_Node_Id;
-- 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.
+ -- Reference to the last string elements in Result, when Kind is List
begin
- Result.Location := Location_Of (First_Term);
+ Result.Project := Project;
+ Result.Location := Location_Of (First_Term, From_Project_Node_Tree);
-- Process each term of the expression, starting with First_Term
- while The_Term /= Empty_Node loop
+ The_Term := First_Term;
+ while Present (The_Term) loop
+ The_Current_Term := Current_Term (The_Term, From_Project_Node_Tree);
- -- 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
+ case Kind_Of (The_Current_Term, From_Project_Node_Tree) is
when N_Literal_String =>
raise Program_Error;
when Single =>
- Add (Result.Value, String_Value_Of (The_Current_Term));
+ Add (Result.Value,
+ String_Value_Of
+ (The_Current_Term, From_Project_Node_Tree));
+ Result.Index :=
+ Source_Index_Of
+ (The_Current_Term, From_Project_Node_Tree);
when List =>
- String_Elements.Increment_Last;
+ String_Element_Table.Increment_Last
+ (In_Tree.String_Elements);
if Last = Nil_String then
- -- This can happen in an expression such as
- -- () & "toto"
+ -- This can happen in an expression like () & "toto"
- Result.Values := String_Elements.Last;
+ Result.Values := String_Element_Table.Last
+ (In_Tree.String_Elements);
else
- String_Elements.Table (Last).Next :=
- String_Elements.Last;
+ In_Tree.String_Elements.Table
+ (Last).Next := String_Element_Table.Last
+ (In_Tree.String_Elements);
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);
-
+ Last := String_Element_Table.Last
+ (In_Tree.String_Elements);
+
+ In_Tree.String_Elements.Table (Last) :=
+ (Value => String_Value_Of
+ (The_Current_Term,
+ From_Project_Node_Tree),
+ Index => Source_Index_Of
+ (The_Current_Term,
+ From_Project_Node_Tree),
+ Display_Value => No_Name,
+ Location => Location_Of
+ (The_Current_Term,
+ From_Project_Node_Tree),
+ 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);
+ First_Expression_In_List
+ (The_Current_Term,
+ From_Project_Node_Tree);
Value : Variable_Value;
begin
- if String_Node /= Empty_Node then
+ if Present (String_Node) then
- -- If String_Node is nil, it is an empty list,
- -- there is nothing to do
+ -- 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;
+ (Project => Project,
+ In_Tree => In_Tree,
+ Flags => Flags,
+ From_Project_Node => From_Project_Node,
+ From_Project_Node_Tree => From_Project_Node_Tree,
+ Pkg => Pkg,
+ First_Term =>
+ Tree.First_Term
+ (String_Node, From_Project_Node_Tree),
+ Kind => Single);
+ String_Element_Table.Increment_Last
+ (In_Tree.String_Elements);
if Result.Values = Nil_String then
- -- This literal string list is the first term
- -- in a string list expression
+ -- This literal string list is the first term in a
+ -- string list expression
- Result.Values := String_Elements.Last;
+ Result.Values :=
+ String_Element_Table.Last (In_Tree.String_Elements);
else
- String_Elements.Table (Last).Next :=
- String_Elements.Last;
+ In_Tree.String_Elements.Table
+ (Last).Next :=
+ String_Element_Table.Last (In_Tree.String_Elements);
end if;
- Last := String_Elements.Last;
- String_Elements.Table (Last) :=
+ Last :=
+ String_Element_Table.Last (In_Tree.String_Elements);
+
+ In_Tree.String_Elements.Table (Last) :=
(Value => Value.Value,
+ Display_Value => No_Name,
Location => Value.Location,
- Next => Nil_String);
+ Flag => False,
+ Next => Nil_String,
+ Index => Value.Index);
loop
-- Add the other element of the literal string list
-- one after the other
String_Node :=
- Next_Expression_In_List (String_Node);
+ Next_Expression_In_List
+ (String_Node, From_Project_Node_Tree);
- exit when String_Node = Empty_Node;
+ exit when No (String_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) :=
+ (Project => Project,
+ In_Tree => In_Tree,
+ Flags => Flags,
+ From_Project_Node => From_Project_Node,
+ From_Project_Node_Tree => From_Project_Node_Tree,
+ Pkg => Pkg,
+ First_Term =>
+ Tree.First_Term
+ (String_Node, From_Project_Node_Tree),
+ Kind => Single);
+
+ String_Element_Table.Increment_Last
+ (In_Tree.String_Elements);
+ In_Tree.String_Elements.Table
+ (Last).Next := String_Element_Table.Last
+ (In_Tree.String_Elements);
+ Last := String_Element_Table.Last
+ (In_Tree.String_Elements);
+ In_Tree.String_Elements.Table (Last) :=
(Value => Value.Value,
+ Display_Value => No_Name,
Location => Value.Location,
- Next => Nil_String);
+ Flag => False,
+ Next => Nil_String,
+ Index => Value.Index);
end loop;
-
end if;
-
end;
when N_Variable_Reference | N_Attribute_Reference =>
The_Variable_Id : Variable_Id := No_Variable;
The_Variable : Variable_Value;
Term_Project : constant Project_Node_Id :=
- Project_Node_Of (The_Current_Term);
+ Project_Node_Of
+ (The_Current_Term,
+ From_Project_Node_Tree);
Term_Package : constant Project_Node_Id :=
- Package_Node_Of (The_Current_Term);
- Index : String_Id := No_String;
+ Package_Node_Of
+ (The_Current_Term,
+ From_Project_Node_Tree);
+ Index : Name_Id := No_Name;
begin
- if Term_Project /= Empty_Node and then
+ if Present (Term_Project) 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);
+ The_Name :=
+ Name_Of (Term_Project, From_Project_Node_Tree);
+ The_Project := Imported_Or_Extended_Project_From
+ (Project => Project,
+ With_Name => The_Name);
end if;
- if Term_Package /= Empty_Node then
+ if Present (Term_Package) then
-- This is an attribute of a package
- The_Name := Name_Of (Term_Package);
- The_Package := Projects.Table (The_Project).Decl.Packages;
+ The_Name :=
+ Name_Of (Term_Package, From_Project_Node_Tree);
+ The_Package := The_Project.Decl.Packages;
while The_Package /= No_Package
- and then Packages.Table (The_Package).Name /= The_Name
+ and then In_Tree.Packages.Table
+ (The_Package).Name /= The_Name
loop
- The_Package := Packages.Table (The_Package).Next;
+ The_Package :=
+ In_Tree.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
+ elsif Kind_Of (The_Current_Term, From_Project_Node_Tree) =
+ N_Attribute_Reference
+ then
The_Package := No_Package;
end if;
- The_Name := Name_Of (The_Current_Term);
+ The_Name :=
+ Name_Of (The_Current_Term, From_Project_Node_Tree);
- if Kind_Of (The_Current_Term) = N_Attribute_Reference then
- Index := Associative_Array_Index_Of (The_Current_Term);
+ if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
+ N_Attribute_Reference
+ then
+ Index :=
+ Associative_Array_Index_Of
+ (The_Current_Term, From_Project_Node_Tree);
end if;
-- If it is not an associative array attribute
- if Index = No_String then
+ if Index = No_Name then
-- It is not an associative array attribute
-- First, if there is a package, look into the package
- if
- Kind_Of (The_Current_Term) = N_Variable_Reference
+ if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
+ N_Variable_Reference
then
The_Variable_Id :=
- Packages.Table (The_Package).Decl.Variables;
-
+ In_Tree.Packages.Table
+ (The_Package).Decl.Variables;
else
The_Variable_Id :=
- Packages.Table (The_Package).Decl.Attributes;
+ In_Tree.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
+ In_Tree.Variable_Elements.Table
+ (The_Variable_Id).Name /= The_Name
loop
The_Variable_Id :=
- Variable_Elements.Table (The_Variable_Id).Next;
+ In_Tree.Variable_Elements.Table
+ (The_Variable_Id).Next;
end loop;
end if;
-- If we have not found it, look into the project
- if
- Kind_Of (The_Current_Term) = N_Variable_Reference
+ if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
+ N_Variable_Reference
then
- The_Variable_Id :=
- Projects.Table (The_Project).Decl.Variables;
-
+ The_Variable_Id := The_Project.Decl.Variables;
else
- The_Variable_Id :=
- Projects.Table (The_Project).Decl.Attributes;
+ The_Variable_Id := The_Project.Decl.Attributes;
end if;
while The_Variable_Id /= No_Variable
and then
- Variable_Elements.Table (The_Variable_Id).Name /=
- The_Name
+ In_Tree.Variable_Elements.Table
+ (The_Variable_Id).Name /= The_Name
loop
The_Variable_Id :=
- Variable_Elements.Table (The_Variable_Id).Next;
+ In_Tree.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 :=
+ In_Tree.Variable_Elements.Table
(The_Variable_Id).Value;
else
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;
-
+ In_Tree.Packages.Table
+ (The_Package).Decl.Arrays;
else
- The_Array :=
- Projects.Table (The_Project).Decl.Arrays;
+ The_Array := The_Project.Decl.Arrays;
end if;
while The_Array /= No_Array
- and then Arrays.Table (The_Array).Name /= The_Name
+ and then In_Tree.Arrays.Table
+ (The_Array).Name /= The_Name
loop
- The_Array := Arrays.Table (The_Array).Next;
+ The_Array := In_Tree.Arrays.Table
+ (The_Array).Next;
end loop;
if The_Array /= No_Array then
- The_Element := Arrays.Table (The_Array).Value;
-
- String_To_Name_Buffer (Index);
-
- if Case_Insensitive (The_Current_Term) then
- To_Lower (Name_Buffer (1 .. Name_Len));
- end if;
-
- Array_Index := Name_Find;
+ The_Element := In_Tree.Arrays.Table
+ (The_Array).Value;
+ Array_Index :=
+ Get_Attribute_Index
+ (From_Project_Node_Tree,
+ The_Current_Term,
+ Index);
while The_Element /= No_Array_Element
- and then Array_Elements.Table (The_Element).Index
- /= Array_Index
+ and then
+ In_Tree.Array_Elements.Table
+ (The_Element).Index /= Array_Index
loop
The_Element :=
- Array_Elements.Table (The_Element).Next;
+ In_Tree.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;
+ In_Tree.Array_Elements.Table
+ (The_Element).Value;
else
- if
- Expression_Kind_Of (The_Current_Term) = List
+ if Expression_Kind_Of
+ (The_Current_Term, From_Project_Node_Tree) =
+ List
then
The_Variable :=
- (Kind => List,
+ (Project => Project,
+ Kind => List,
Location => No_Location,
Default => True,
Values => Nil_String);
-
else
The_Variable :=
- (Kind => Single,
+ (Project => Project,
+ Kind => Single,
Location => No_Location,
Default => True,
- Value => Empty_String);
+ Value => Empty_String,
+ Index => 0);
end if;
-
end if;
-
end;
-
end if;
case Kind is
"list cannot appear in single " &
"string expression");
null;
-
end case;
when List =>
null;
when Single =>
- String_Elements.Increment_Last;
+ String_Element_Table.Increment_Last
+ (In_Tree.String_Elements);
if Last = Nil_String then
-- This can happen in an expression such as
-- () & Var
- Result.Values := String_Elements.Last;
+ Result.Values :=
+ String_Element_Table.Last
+ (In_Tree.String_Elements);
else
- String_Elements.Table (Last).Next :=
- String_Elements.Last;
+ In_Tree.String_Elements.Table
+ (Last).Next :=
+ String_Element_Table.Last
+ (In_Tree.String_Elements);
end if;
- Last := String_Elements.Last;
- String_Elements.Table (Last) :=
- (Value => The_Variable.Value,
- Location => Location_Of (The_Current_Term),
- Next => Nil_String);
+ Last :=
+ String_Element_Table.Last
+ (In_Tree.String_Elements);
+
+ In_Tree.String_Elements.Table (Last) :=
+ (Value => The_Variable.Value,
+ Display_Value => No_Name,
+ Location => Location_Of
+ (The_Current_Term,
+ From_Project_Node_Tree),
+ Flag => False,
+ Next => Nil_String,
+ Index => 0);
when List =>
begin
while The_List /= Nil_String loop
- String_Elements.Increment_Last;
+ String_Element_Table.Increment_Last
+ (In_Tree.String_Elements);
if Last = Nil_String then
- Result.Values := String_Elements.Last;
+ Result.Values :=
+ String_Element_Table.Last
+ (In_Tree.
+ String_Elements);
else
- String_Elements.Table (Last).Next :=
- String_Elements.Last;
+ In_Tree.
+ String_Elements.Table (Last).Next :=
+ String_Element_Table.Last
+ (In_Tree.
+ String_Elements);
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;
+ Last :=
+ String_Element_Table.Last
+ (In_Tree.String_Elements);
+
+ In_Tree.String_Elements.Table (Last) :=
+ (Value =>
+ In_Tree.String_Elements.Table
+ (The_List).Value,
+ Display_Value => No_Name,
+ Location =>
+ Location_Of
+ (The_Current_Term,
+ From_Project_Node_Tree),
+ Flag => False,
+ Next => Nil_String,
+ Index => 0);
+ The_List :=
+ In_Tree. String_Elements.Table
+ (The_List).Next;
end loop;
end;
end case;
end;
when N_External_Value =>
- String_To_Name_Buffer
- (String_Value_Of (External_Reference_Of (The_Current_Term)));
+ Get_Name_String
+ (String_Value_Of
+ (External_Reference_Of
+ (The_Current_Term, From_Project_Node_Tree),
+ From_Project_Node_Tree));
declare
Name : constant Name_Id := Name_Find;
- Default : String_Id := No_String;
- Value : String_Id := No_String;
+ Default : Name_Id := No_Name;
+ Value : Name_Id := No_Name;
+
+ Def_Var : Variable_Value;
Default_Node : constant Project_Node_Id :=
- External_Default_Of (The_Current_Term);
+ External_Default_Of
+ (The_Current_Term, From_Project_Node_Tree);
begin
- if Default_Node /= Empty_Node then
- Default := String_Value_Of (Default_Node);
+ -- If there is a default value for the external reference,
+ -- get its value.
+
+ if Present (Default_Node) then
+ Def_Var := Expression
+ (Project => Project,
+ In_Tree => In_Tree,
+ Flags => Flags,
+ From_Project_Node => From_Project_Node,
+ From_Project_Node_Tree => From_Project_Node_Tree,
+ Pkg => Pkg,
+ First_Term =>
+ Tree.First_Term
+ (Default_Node, From_Project_Node_Tree),
+ Kind => Single);
+
+ if Def_Var /= Nil_Variable_Value then
+ Default := Def_Var.Value;
+ end if;
end if;
- Value := Prj.Ext.Value_Of (Name, Default);
+ Value :=
+ Prj.Ext.Value_Of (From_Project_Node_Tree, Name, Default);
- if Value = No_String then
- if Error_Report = null then
+ if Value = No_Name then
+ if not Quiet_Output then
Error_Msg
- ("undefined external reference",
- Location_Of (The_Current_Term));
-
- else
- Error_Report
- ("""" & Get_Name_String (Name) &
- """ is an undefined external reference",
+ (Flags, "?undefined external reference",
+ Location_Of
+ (The_Current_Term, From_Project_Node_Tree),
Project);
end if;
Value := Empty_String;
-
end if;
case Kind is
Add (Result.Value, Value);
when List =>
- String_Elements.Increment_Last;
+ String_Element_Table.Increment_Last
+ (In_Tree.String_Elements);
if Last = Nil_String then
- Result.Values := String_Elements.Last;
+ Result.Values := String_Element_Table.Last
+ (In_Tree.String_Elements);
else
- String_Elements.Table (Last).Next :=
- String_Elements.Last;
+ In_Tree.String_Elements.Table
+ (Last).Next := String_Element_Table.Last
+ (In_Tree.String_Elements);
end if;
- Last := String_Elements.Last;
- String_Elements.Table (Last) :=
+ Last := String_Element_Table.Last
+ (In_Tree.String_Elements);
+ In_Tree.String_Elements.Table (Last) :=
(Value => Value,
- Location => Location_Of (The_Current_Term),
- Next => Nil_String);
+ Display_Value => No_Name,
+ Location =>
+ Location_Of
+ (The_Current_Term, From_Project_Node_Tree),
+ Flag => False,
+ Next => Nil_String,
+ Index => 0);
end case;
-
end;
when others =>
end case;
- The_Term := Next_Term (The_Term);
+ The_Term := Next_Term (The_Term, From_Project_Node_Tree);
end loop;
return Result;
end Expression;
---------------------------------------
- -- Imported_Or_Modified_Project_From --
+ -- Imported_Or_Extended_Project_From --
---------------------------------------
- function Imported_Or_Modified_Project_From
+ function Imported_Or_Extended_Project_From
(Project : Project_Id;
- With_Name : Name_Id)
- return Project_Id
+ With_Name : Name_Id) return Project_Id
is
- Data : constant Project_Data := Projects.Table (Project);
- List : Project_List := Data.Imported_Projects;
+ List : Project_List;
+ Result : Project_Id;
+ Temp_Result : Project_Id;
begin
- -- First check if it is the name of a modified project
+ -- First check if it is the name of an extended project
+
+ Result := Project.Extends;
+ while Result /= No_Project loop
+ if Result.Name = With_Name then
+ return Result;
+ else
+ Result := Result.Extends;
+ end if;
+ end loop;
- if Data.Modifies /= No_Project
- and then Projects.Table (Data.Modifies).Name = With_Name
- then
- return Data.Modifies;
+ -- Then check the name of each imported project
- else
- -- Then check the name of each imported project
+ Temp_Result := No_Project;
+ List := Project.Imported_Projects;
+ while List /= null loop
+ Result := List.Project;
- while List /= Empty_Project_List
- and then
- Projects.Table
- (Project_Lists.Table (List).Project).Name /= With_Name
+ -- If the project is directly imported, then returns its ID
- loop
- List := Project_Lists.Table (List).Next;
- end loop;
+ if Result.Name = With_Name then
+ return Result;
+ end if;
- pragma Assert
- (List /= Empty_Project_List,
- "project not found");
+ -- If a project extending the project is imported, then keep this
+ -- extending project as a possibility. It will be the returned ID
+ -- if the project is not imported directly.
- return Project_Lists.Table (List).Project;
- end if;
- end Imported_Or_Modified_Project_From;
+ declare
+ Proj : Project_Id;
+
+ begin
+ Proj := Result.Extends;
+ while Proj /= No_Project loop
+ if Proj.Name = With_Name then
+ Temp_Result := Result;
+ exit;
+ end if;
+
+ Proj := Proj.Extends;
+ end loop;
+ end;
+
+ List := List.Next;
+ end loop;
+
+ pragma Assert (Temp_Result /= No_Project, "project not found");
+ return Temp_Result;
+ end Imported_Or_Extended_Project_From;
------------------
-- Package_From --
function Package_From
(Project : Project_Id;
- With_Name : Name_Id)
- return Package_Id
+ In_Tree : Project_Tree_Ref;
+ With_Name : Name_Id) return Package_Id
is
- Data : constant Project_Data := Projects.Table (Project);
- Result : Package_Id := Data.Decl.Packages;
+ Result : Package_Id := Project.Decl.Packages;
begin
-- Check the name of each existing package of Project
while Result /= No_Package
- and then
- Packages.Table (Result).Name /= With_Name
+ and then In_Tree.Packages.Table (Result).Name /= With_Name
loop
- Result := Packages.Table (Result).Next;
+ Result := In_Tree.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;
-------------
procedure Process
- (Project : out Project_Id;
- From_Project_Node : Project_Node_Id;
- Report_Error : Put_Line_Access)
+ (In_Tree : Project_Tree_Ref;
+ Project : out Project_Id;
+ Success : out Boolean;
+ From_Project_Node : Project_Node_Id;
+ From_Project_Node_Tree : Project_Node_Tree_Ref;
+ Flags : Processing_Flags;
+ Reset_Tree : Boolean := True)
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.Total_Errors_Detected > 0 then
- Project := No_Project;
- end if;
-
- if Project /= No_Project then
- Check (Project);
+ Process_Project_Tree_Phase_1
+ (In_Tree => In_Tree,
+ Project => Project,
+ Success => Success,
+ From_Project_Node => From_Project_Node,
+ From_Project_Node_Tree => From_Project_Node_Tree,
+ Flags => Flags,
+ Reset_Tree => Reset_Tree);
+
+ if Project_Qualifier_Of (From_Project_Node, From_Project_Node_Tree) /=
+ Configuration
+ then
+ Process_Project_Tree_Phase_2
+ (In_Tree => In_Tree,
+ Project => Project,
+ Success => Success,
+ From_Project_Node => From_Project_Node,
+ From_Project_Node_Tree => From_Project_Node_Tree,
+ Flags => Flags);
end if;
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;
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Flags : Processing_Flags;
+ From_Project_Node : Project_Node_Id;
+ From_Project_Node_Tree : Project_Node_Tree_Ref;
+ Pkg : Package_Id;
+ Item : Project_Node_Id)
+ is
+ Current_Declarative_Item : Project_Node_Id;
+ Current_Item : Project_Node_Id;
begin
- -- For each declarative item
+ -- Loop through declarative items
+
+ Current_Item := Empty_Node;
- while Current_Declarative_Item /= Empty_Node loop
+ Current_Declarative_Item := Item;
+ while Present (Current_Declarative_Item) loop
-- Get its data
- Current_Item := Current_Item_Node (Current_Declarative_Item);
+ Current_Item :=
+ Current_Item_Node
+ (Current_Declarative_Item, From_Project_Node_Tree);
-- And set Current_Declarative_Item to the next declarative item
- -- ready for the next iteration
+ -- ready for the next iteration.
- Current_Declarative_Item := Next_Declarative_Item
- (Current_Declarative_Item);
+ Current_Declarative_Item :=
+ Next_Declarative_Item
+ (Current_Declarative_Item, From_Project_Node_Tree);
- case Kind_Of (Current_Item) is
+ case Kind_Of (Current_Item, From_Project_Node_Tree) is
when N_Package_Declaration =>
- Packages.Increment_Last;
- declare
- New_Pkg : constant Package_Id := Packages.Last;
- The_New_Package : Package_Element;
+ -- Do not process a package declaration that should be ignored
- Project_Of_Renamed_Package : constant Project_Node_Id :=
- Project_Of_Renamed_Package_Of
- (Current_Item);
+ if Expression_Kind_Of
+ (Current_Item, From_Project_Node_Tree) /= Ignored
+ then
+ -- Create the new package
- begin
- The_New_Package.Name := Name_Of (Current_Item);
+ Package_Table.Increment_Last (In_Tree.Packages);
- 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;
+ declare
+ New_Pkg : constant Package_Id :=
+ Package_Table.Last (In_Tree.Packages);
+ The_New_Package : Package_Element;
- Packages.Table (New_Pkg) := The_New_Package;
+ Project_Of_Renamed_Package :
+ constant Project_Node_Id :=
+ Project_Of_Renamed_Package_Of
+ (Current_Item, From_Project_Node_Tree);
- if Project_Of_Renamed_Package /= Empty_Node then
+ begin
+ -- Set the name of the new package
- -- Renamed package
+ The_New_Package.Name :=
+ Name_Of (Current_Item, From_Project_Node_Tree);
- declare
- Project_Name : constant Name_Id :=
- Name_Of
- (Project_Of_Renamed_Package);
+ -- Insert the new package in the appropriate list
+
+ if Pkg /= No_Package then
+ The_New_Package.Next :=
+ In_Tree.Packages.Table (Pkg).Decl.Packages;
+ In_Tree.Packages.Table (Pkg).Decl.Packages :=
+ New_Pkg;
- Renamed_Project : constant Project_Id :=
- Imported_Or_Modified_Project_From
- (Project, Project_Name);
+ else
+ The_New_Package.Next := Project.Decl.Packages;
+ Project.Decl.Packages := New_Pkg;
+ end if;
- Renamed_Package : constant Package_Id :=
- Package_From
- (Renamed_Project,
- Name_Of (Current_Item));
+ In_Tree.Packages.Table (New_Pkg) :=
+ The_New_Package;
- begin
- Packages.Table (New_Pkg).Decl :=
- Packages.Table (Renamed_Package).Decl;
- end;
+ if Present (Project_Of_Renamed_Package) then
- else
- -- Set the default values of the attributes
+ -- Renamed package
- Add_Attributes
- (Packages.Table (New_Pkg).Decl,
- Package_Attributes.Table
- (Package_Id_Of (Current_Item)).First_Attribute);
+ declare
+ Project_Name : constant Name_Id :=
+ Name_Of
+ (Project_Of_Renamed_Package,
+ From_Project_Node_Tree);
+
+ Renamed_Project :
+ constant Project_Id :=
+ Imported_Or_Extended_Project_From
+ (Project, Project_Name);
+
+ Renamed_Package : constant Package_Id :=
+ Package_From
+ (Renamed_Project, In_Tree,
+ Name_Of
+ (Current_Item,
+ From_Project_Node_Tree));
- Process_Declarative_Items
- (Project => Project,
- From_Project_Node => From_Project_Node,
- Pkg => New_Pkg,
- Item => First_Declarative_Item_Of
- (Current_Item));
- end if;
+ begin
+ -- For a renamed package, copy the declarations of
+ -- the renamed package, but set all the locations
+ -- to the location of the package name in the
+ -- renaming declaration.
+
+ Copy_Package_Declarations
+ (From =>
+ In_Tree.Packages.Table (Renamed_Package).Decl,
+ To =>
+ In_Tree.Packages.Table (New_Pkg).Decl,
+ New_Loc =>
+ Location_Of
+ (Current_Item, From_Project_Node_Tree),
+ Naming_Restricted => False,
+ In_Tree => In_Tree);
+ end;
- end;
+ -- Standard package declaration, not renaming
+
+ else
+ -- Set the default values of the attributes
+
+ Add_Attributes
+ (Project,
+ Project.Name,
+ Name_Id (Project.Directory.Name),
+ In_Tree,
+ In_Tree.Packages.Table (New_Pkg).Decl,
+ First_Attribute_Of
+ (Package_Id_Of
+ (Current_Item, From_Project_Node_Tree)),
+ Project_Level => False);
+
+ -- And process declarative items of the new package
+
+ Process_Declarative_Items
+ (Project => Project,
+ In_Tree => In_Tree,
+ Flags => Flags,
+ From_Project_Node => From_Project_Node,
+ From_Project_Node_Tree => From_Project_Node_Tree,
+ Pkg => New_Pkg,
+ Item =>
+ First_Declarative_Item_Of
+ (Current_Item, From_Project_Node_Tree));
+ end if;
+ end;
+ end if;
when N_String_Type_Declaration =>
N_Typed_Variable_Declaration |
N_Variable_Declaration =>
- pragma Assert (Expression_Of (Current_Item) /= Empty_Node,
- "no expression for an object declaration");
+ if Expression_Of (Current_Item, From_Project_Node_Tree) =
+ Empty_Node
+ then
- 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);
+ -- It must be a full associative array attribute declaration
- begin
- if Kind_Of (Current_Item) = N_Typed_Variable_Declaration then
+ declare
+ Current_Item_Name : constant Name_Id :=
+ Name_Of
+ (Current_Item,
+ From_Project_Node_Tree);
+ -- The name of the attribute
- if String_Equal (New_Value.Value, Empty_String) then
- Error_Msg_Name_1 := Name_Of (Current_Item);
+ Current_Location : constant Source_Ptr :=
+ Location_Of
+ (Current_Item,
+ From_Project_Node_Tree);
- if Error_Report = null then
- Error_Msg
- ("no value defined for %",
- Location_Of (Current_Item));
+ New_Array : Array_Id;
+ -- The new associative array created
- else
- Error_Report
- ("no value defined for " &
- Get_Name_String (Error_Msg_Name_1),
- Project);
- end if;
+ Orig_Array : Array_Id;
+ -- The associative array value
- else
- declare
- Current_String : Project_Node_Id :=
- First_Literal_String
- (String_Type_Of
- (Current_Item));
+ Orig_Project_Name : Name_Id := No_Name;
+ -- The name of the project where the associative array
+ -- value is.
- 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;
+ Orig_Project : Project_Id := No_Project;
+ -- The id of the project where the associative array
+ -- value is.
- 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);
+ Orig_Package_Name : Name_Id := No_Name;
+ -- The name of the package, if any, where the associative
+ -- array value is.
- if Error_Report = null then
- Error_Msg
- ("value { is illegal for typed string %",
- Location_Of (Current_Item));
+ Orig_Package : Package_Id := No_Package;
+ -- The id of the package, if any, where the associative
+ -- array value is.
- 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;
+ New_Element : Array_Element_Id := No_Array_Element;
+ -- Id of a new array element created
- if Kind_Of (Current_Item) /= N_Attribute_Declaration
- or else
- Associative_Array_Index_Of (Current_Item) = No_String
- then
- -- Usual case
+ Prev_Element : Array_Element_Id := No_Array_Element;
+ -- Last new element id created
- -- Code below really needs more comments ???
+ Orig_Element : Array_Element_Id := No_Array_Element;
+ -- Current array element in original associative array
- if Kind_Of (Current_Item) = N_Attribute_Declaration then
- if Pkg /= No_Package then
- The_Variable :=
- Packages.Table (Pkg).Decl.Attributes;
+ Next_Element : Array_Element_Id := No_Array_Element;
+ -- Id of the array element that follows the new element.
+ -- This is not always nil, because values for the
+ -- associative array attribute may already have been
+ -- declared, and the array elements declared are reused.
- else
- The_Variable :=
- Projects.Table (Project).Decl.Attributes;
- end if;
+ Prj : Project_List;
- else
- if Pkg /= No_Package then
- The_Variable :=
- Packages.Table (Pkg).Decl.Variables;
+ begin
+ -- First find if the associative array attribute already
+ -- has elements declared.
- else
- The_Variable :=
- Projects.Table (Project).Decl.Variables;
- end if;
+ if Pkg /= No_Package then
+ New_Array := In_Tree.Packages.Table
+ (Pkg).Decl.Arrays;
+ else
+ New_Array := Project.Decl.Arrays;
end if;
- while
- The_Variable /= No_Variable
- and then
- Variable_Elements.Table (The_Variable).Name /=
- Current_Item_Name
+ while New_Array /= No_Array
+ and then In_Tree.Arrays.Table (New_Array).Name /=
+ Current_Item_Name
loop
- The_Variable :=
- Variable_Elements.Table (The_Variable).Next;
+ New_Array := In_Tree.Arrays.Table (New_Array).Next;
end loop;
- if The_Variable = No_Variable then
- pragma Assert
- (Kind_Of (Current_Item) /= N_Attribute_Declaration,
- "illegal attribute declaration");
+ -- If the attribute has never been declared add new entry
+ -- in the arrays of the project/package and link it.
- Variable_Elements.Increment_Last;
- The_Variable := Variable_Elements.Last;
+ if New_Array = No_Array then
+ Array_Table.Increment_Last (In_Tree.Arrays);
+ New_Array := Array_Table.Last (In_Tree.Arrays);
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;
+ In_Tree.Arrays.Table (New_Array) :=
+ (Name => Current_Item_Name,
+ Location => Current_Location,
+ Value => No_Array_Element,
+ Next => In_Tree.Packages.Table
+ (Pkg).Decl.Arrays);
+
+ In_Tree.Packages.Table (Pkg).Decl.Arrays :=
+ New_Array;
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;
+ In_Tree.Arrays.Table (New_Array) :=
+ (Name => Current_Item_Name,
+ Location => Current_Location,
+ Value => No_Array_Element,
+ Next => Project.Decl.Arrays);
+
+ Project.Decl.Arrays := New_Array;
+ end if;
+ end if;
+
+ -- Find the project where the value is declared
+
+ Orig_Project_Name :=
+ Name_Of
+ (Associative_Project_Of
+ (Current_Item, From_Project_Node_Tree),
+ From_Project_Node_Tree);
+
+ Prj := In_Tree.Projects;
+ while Prj /= null loop
+ if Prj.Project.Name = Orig_Project_Name then
+ Orig_Project := Prj.Project;
+ exit;
end if;
+ Prj := Prj.Next;
+ end loop;
+
+ pragma Assert (Orig_Project /= No_Project,
+ "original project not found");
+
+ if No (Associative_Package_Of
+ (Current_Item, From_Project_Node_Tree))
+ then
+ Orig_Array := Orig_Project.Decl.Arrays;
else
- Variable_Elements.Table (The_Variable).Value :=
- New_Value;
+ -- If in a package, find the package where the value
+ -- is declared.
+
+ Orig_Package_Name :=
+ Name_Of
+ (Associative_Package_Of
+ (Current_Item, From_Project_Node_Tree),
+ From_Project_Node_Tree);
+ Orig_Package := Orig_Project.Decl.Packages;
+ pragma Assert (Orig_Package /= No_Package,
+ "original package not found");
+
+ while In_Tree.Packages.Table
+ (Orig_Package).Name /= Orig_Package_Name
+ loop
+ Orig_Package := In_Tree.Packages.Table
+ (Orig_Package).Next;
+ pragma Assert (Orig_Package /= No_Package,
+ "original package not found");
+ end loop;
+
+ Orig_Array :=
+ In_Tree.Packages.Table (Orig_Package).Decl.Arrays;
end if;
- else
- -- Associative array attribute
+ -- Now look for the array
- String_To_Name_Buffer
- (Associative_Array_Index_Of (Current_Item));
+ while Orig_Array /= No_Array
+ and then In_Tree.Arrays.Table (Orig_Array).Name /=
+ Current_Item_Name
+ loop
+ Orig_Array := In_Tree.Arrays.Table
+ (Orig_Array).Next;
+ end loop;
- if Case_Insensitive (Current_Item) then
- GNAT.Case_Util.To_Lower (Name_Buffer (1 .. Name_Len));
+ if Orig_Array = No_Array then
+ Error_Msg
+ (Flags,
+ "associative array value not found",
+ Location_Of (Current_Item, From_Project_Node_Tree),
+ Project);
+
+ else
+ Orig_Element :=
+ In_Tree.Arrays.Table (Orig_Array).Value;
+
+ -- Copy each array element
+
+ while Orig_Element /= No_Array_Element loop
+
+ -- Case of first element
+
+ if Prev_Element = No_Array_Element then
+
+ -- And there is no array element declared yet,
+ -- create a new first array element.
+
+ if In_Tree.Arrays.Table (New_Array).Value =
+ No_Array_Element
+ then
+ Array_Element_Table.Increment_Last
+ (In_Tree.Array_Elements);
+ New_Element := Array_Element_Table.Last
+ (In_Tree.Array_Elements);
+ In_Tree.Arrays.Table
+ (New_Array).Value := New_Element;
+ Next_Element := No_Array_Element;
+
+ -- Otherwise, the new element is the first
+
+ else
+ New_Element := In_Tree.Arrays.
+ Table (New_Array).Value;
+ Next_Element :=
+ In_Tree.Array_Elements.Table
+ (New_Element).Next;
+ end if;
+
+ -- Otherwise, reuse an existing element, or create
+ -- one if necessary.
+
+ else
+ Next_Element :=
+ In_Tree.Array_Elements.Table
+ (Prev_Element).Next;
+
+ if Next_Element = No_Array_Element then
+ Array_Element_Table.Increment_Last
+ (In_Tree.Array_Elements);
+ New_Element :=
+ Array_Element_Table.Last
+ (In_Tree.Array_Elements);
+ In_Tree.Array_Elements.Table
+ (Prev_Element).Next := New_Element;
+
+ else
+ New_Element := Next_Element;
+ Next_Element :=
+ In_Tree.Array_Elements.Table
+ (New_Element).Next;
+ end if;
+ end if;
+
+ -- Copy the value of the element
+
+ In_Tree.Array_Elements.Table
+ (New_Element) :=
+ In_Tree.Array_Elements.Table (Orig_Element);
+ In_Tree.Array_Elements.Table
+ (New_Element).Value.Project := Project;
+
+ -- Adjust the Next link
+
+ In_Tree.Array_Elements.Table
+ (New_Element).Next := Next_Element;
+
+ -- Adjust the previous id for the next element
+
+ Prev_Element := New_Element;
+
+ -- Go to the next element in the original array
+
+ Orig_Element :=
+ In_Tree.Array_Elements.Table
+ (Orig_Element).Next;
+ end loop;
+
+ -- Make sure that the array ends here, in case there
+ -- previously a greater number of elements.
+
+ In_Tree.Array_Elements.Table
+ (New_Element).Next := No_Array_Element;
end if;
+ end;
- declare
- The_Array : Array_Id;
+ -- Declarations other that full associative arrays
- The_Array_Element : Array_Element_Id :=
- No_Array_Element;
+ else
+ declare
+ New_Value : constant Variable_Value :=
+ Expression
+ (Project => Project,
+ In_Tree => In_Tree,
+ Flags => Flags,
+ From_Project_Node => From_Project_Node,
+ From_Project_Node_Tree => From_Project_Node_Tree,
+ Pkg => Pkg,
+ First_Term =>
+ Tree.First_Term
+ (Expression_Of
+ (Current_Item, From_Project_Node_Tree),
+ From_Project_Node_Tree),
+ Kind =>
+ Expression_Kind_Of
+ (Current_Item, From_Project_Node_Tree));
+ -- The expression value
+
+ The_Variable : Variable_Id := No_Variable;
+
+ Current_Item_Name : constant Name_Id :=
+ Name_Of
+ (Current_Item,
+ From_Project_Node_Tree);
+
+ Current_Location : constant Source_Ptr :=
+ Location_Of
+ (Current_Item,
+ From_Project_Node_Tree);
- Index_Name : constant Name_Id := Name_Find;
+ begin
+ -- Process a typed variable declaration
- begin
+ if Kind_Of (Current_Item, From_Project_Node_Tree) =
+ N_Typed_Variable_Declaration
+ then
+ -- Report an error for an empty string
- if Pkg /= No_Package then
- The_Array := Packages.Table (Pkg).Decl.Arrays;
+ if New_Value.Value = Empty_String then
+ Error_Msg_Name_1 :=
+ Name_Of (Current_Item, From_Project_Node_Tree);
+ Error_Msg
+ (Flags,
+ "no value defined for %%",
+ Location_Of
+ (Current_Item, From_Project_Node_Tree),
+ Project);
else
- The_Array := Projects.Table (Project).Decl.Arrays;
+ declare
+ Current_String : Project_Node_Id;
+
+ begin
+ -- Loop through all the valid strings for the
+ -- string type and compare to the string value.
+
+ Current_String :=
+ First_Literal_String
+ (String_Type_Of (Current_Item,
+ From_Project_Node_Tree),
+ From_Project_Node_Tree);
+ while Present (Current_String)
+ and then
+ String_Value_Of
+ (Current_String, From_Project_Node_Tree) /=
+ New_Value.Value
+ loop
+ Current_String :=
+ Next_Literal_String
+ (Current_String, From_Project_Node_Tree);
+ end loop;
+
+ -- Report an error if the string value is not
+ -- one for the string type.
+
+ if No (Current_String) then
+ Error_Msg_Name_1 := New_Value.Value;
+ Error_Msg_Name_2 :=
+ Name_Of
+ (Current_Item, From_Project_Node_Tree);
+ Error_Msg
+ (Flags,
+ "value %% is illegal for typed string %%",
+ Location_Of
+ (Current_Item, From_Project_Node_Tree),
+ Project);
+ end if;
+ end;
end if;
+ 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;
+ -- Comment here ???
- if The_Array = No_Array then
- Arrays.Increment_Last;
- The_Array := Arrays.Last;
+ if Kind_Of (Current_Item, From_Project_Node_Tree) /=
+ N_Attribute_Declaration
+ or else
+ Associative_Array_Index_Of
+ (Current_Item, From_Project_Node_Tree) = No_Name
+ then
+ -- Case of a variable declaration or of a not
+ -- associative array attribute.
- 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;
+ -- First, find the list where to find the variable
+ -- or attribute.
+ if Kind_Of (Current_Item, From_Project_Node_Tree) =
+ N_Attribute_Declaration
+ then
+ if Pkg /= No_Package then
+ The_Variable :=
+ In_Tree.Packages.Table
+ (Pkg).Decl.Attributes;
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;
+ The_Variable := Project.Decl.Attributes;
end if;
else
- The_Array_Element := Arrays.Table (The_Array).Value;
+ if Pkg /= No_Package then
+ The_Variable :=
+ In_Tree.Packages.Table
+ (Pkg).Decl.Variables;
+ else
+ The_Variable := Project.Decl.Variables;
+ end if;
+
end if;
- while The_Array_Element /= No_Array_Element
+ -- Loop through the list, to find if it has already
+ -- been declared.
+
+ while The_Variable /= No_Variable
and then
- Array_Elements.Table (The_Array_Element).Index /=
- Index_Name
+ In_Tree.Variable_Elements.Table
+ (The_Variable).Name /= Current_Item_Name
loop
- The_Array_Element :=
- Array_Elements.Table (The_Array_Element).Next;
+ The_Variable :=
+ In_Tree.Variable_Elements.Table
+ (The_Variable).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;
+ -- If it has not been declared, create a new entry
+ -- in the list.
+
+ if The_Variable = No_Variable then
+
+ -- All single string attribute should already have
+ -- been declared with a default empty string value.
+
+ pragma Assert
+ (Kind_Of (Current_Item, From_Project_Node_Tree) /=
+ N_Attribute_Declaration,
+ "illegal attribute declaration for "
+ & Get_Name_String (Current_Item_Name));
+
+ Variable_Element_Table.Increment_Last
+ (In_Tree.Variable_Elements);
+ The_Variable := Variable_Element_Table.Last
+ (In_Tree.Variable_Elements);
+
+ -- Put the new variable in the appropriate list
+
+ if Pkg /= No_Package then
+ In_Tree.Variable_Elements.Table (The_Variable) :=
+ (Next =>
+ In_Tree.Packages.Table
+ (Pkg).Decl.Variables,
+ Name => Current_Item_Name,
+ Value => New_Value);
+ In_Tree.Packages.Table
+ (Pkg).Decl.Variables := The_Variable;
+
+ else
+ In_Tree.Variable_Elements.Table (The_Variable) :=
+ (Next => Project.Decl.Variables,
+ Name => Current_Item_Name,
+ Value => New_Value);
+ Project.Decl.Variables := The_Variable;
+ end if;
+
+ -- If the variable/attribute has already been
+ -- declared, just change the value.
else
- Array_Elements.Table (The_Array_Element).Value :=
- New_Value;
+ In_Tree.Variable_Elements.Table
+ (The_Variable).Value := New_Value;
end if;
- end;
- end if;
- end;
+
+ -- Associative array attribute
+
+ else
+ declare
+ Index_Name : Name_Id :=
+ Associative_Array_Index_Of
+ (Current_Item,
+ From_Project_Node_Tree);
+
+ Source_Index : constant Int :=
+ Source_Index_Of
+ (Current_Item,
+ From_Project_Node_Tree);
+
+ The_Array : Array_Id;
+ The_Array_Element : Array_Element_Id :=
+ No_Array_Element;
+
+ begin
+ if Index_Name /= All_Other_Names then
+ Index_Name := Get_Attribute_Index
+ (From_Project_Node_Tree,
+ Current_Item,
+ Associative_Array_Index_Of
+ (Current_Item, From_Project_Node_Tree));
+ end if;
+
+ -- Look for the array in the appropriate list
+
+ if Pkg /= No_Package then
+ The_Array :=
+ In_Tree.Packages.Table (Pkg).Decl.Arrays;
+ else
+ The_Array :=
+ Project.Decl.Arrays;
+ end if;
+
+ while
+ The_Array /= No_Array
+ and then
+ In_Tree.Arrays.Table (The_Array).Name /=
+ Current_Item_Name
+ loop
+ The_Array :=
+ In_Tree.Arrays.Table (The_Array).Next;
+ end loop;
+
+ -- If the array cannot be found, create a new entry
+ -- in the list. As The_Array_Element is initialized
+ -- to No_Array_Element, a new element will be
+ -- created automatically later
+
+ if The_Array = No_Array then
+ Array_Table.Increment_Last (In_Tree.Arrays);
+ The_Array := Array_Table.Last (In_Tree.Arrays);
+
+ if Pkg /= No_Package then
+ In_Tree.Arrays.Table (The_Array) :=
+ (Name => Current_Item_Name,
+ Location => Current_Location,
+ Value => No_Array_Element,
+ Next => In_Tree.Packages.Table
+ (Pkg).Decl.Arrays);
+
+ In_Tree.Packages.Table (Pkg).Decl.Arrays :=
+ The_Array;
+
+ else
+ In_Tree.Arrays.Table (The_Array) :=
+ (Name => Current_Item_Name,
+ Location => Current_Location,
+ Value => No_Array_Element,
+ Next => Project.Decl.Arrays);
+
+ Project.Decl.Arrays := The_Array;
+ end if;
+
+ -- Otherwise initialize The_Array_Element as the
+ -- head of the element list.
+
+ else
+ The_Array_Element :=
+ In_Tree.Arrays.Table (The_Array).Value;
+ end if;
+
+ -- Look in the list, if any, to find an element
+ -- with the same index and same source index.
+
+ while The_Array_Element /= No_Array_Element
+ and then
+ (In_Tree.Array_Elements.Table
+ (The_Array_Element).Index /= Index_Name
+ or else
+ In_Tree.Array_Elements.Table
+ (The_Array_Element).Src_Index /= Source_Index)
+ loop
+ The_Array_Element :=
+ In_Tree.Array_Elements.Table
+ (The_Array_Element).Next;
+ end loop;
+
+ -- If no such element were found, create a new one
+ -- and insert it in the element list, with the
+ -- proper value.
+
+ if The_Array_Element = No_Array_Element then
+ Array_Element_Table.Increment_Last
+ (In_Tree.Array_Elements);
+ The_Array_Element :=
+ Array_Element_Table.Last
+ (In_Tree.Array_Elements);
+
+ In_Tree.Array_Elements.Table
+ (The_Array_Element) :=
+ (Index => Index_Name,
+ Src_Index => Source_Index,
+ Index_Case_Sensitive =>
+ not Case_Insensitive
+ (Current_Item, From_Project_Node_Tree),
+ Value => New_Value,
+ Next =>
+ In_Tree.Arrays.Table (The_Array).Value);
+
+ In_Tree.Arrays.Table (The_Array).Value :=
+ The_Array_Element;
+
+ -- An element with the same index already exists,
+ -- just replace its value with the new one.
+
+ else
+ In_Tree.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 : String_Id := No_String;
+ The_Project : Project_Id := Project;
+ -- The id of the project of the case variable
+
+ The_Package : Package_Id := Pkg;
+ -- The id of the package, if any, of the case variable
+
+ The_Variable : Variable_Value := Nil_Variable_Value;
+ -- The case variable
+
+ Case_Value : Name_Id := No_Name;
+ -- The case variable value
+
Case_Item : Project_Node_Id := Empty_Node;
Choice_String : Project_Node_Id := Empty_Node;
Decl_Item : Project_Node_Id := Empty_Node;
declare
Variable_Node : constant Project_Node_Id :=
Case_Variable_Reference_Of
- (Current_Item);
+ (Current_Item,
+ From_Project_Node_Tree);
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));
+ -- If a project was specified for the case variable,
+ -- get its id.
+
+ if Present (Project_Node_Of
+ (Variable_Node, From_Project_Node_Tree))
+ then
+ Name :=
+ Name_Of
+ (Project_Node_Of
+ (Variable_Node, From_Project_Node_Tree),
+ From_Project_Node_Tree);
The_Project :=
- Imported_Or_Modified_Project_From (Project, Name);
+ 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);
+ -- If a package were specified for the case variable,
+ -- get its id.
+
+ if Present (Package_Node_Of
+ (Variable_Node, From_Project_Node_Tree))
+ then
+ Name :=
+ Name_Of
+ (Package_Node_Of
+ (Variable_Node, From_Project_Node_Tree),
+ From_Project_Node_Tree);
+ The_Package :=
+ Package_From (The_Project, In_Tree, Name);
end if;
- Name := Name_Of (Variable_Node);
+ Name := Name_Of (Variable_Node, From_Project_Node_Tree);
+
+ -- First, look for the case variable into the package,
+ -- if any.
if The_Package /= No_Package then
- Var_Id := Packages.Table (The_Package).Decl.Variables;
- Name := Name_Of (Variable_Node);
+ Var_Id := In_Tree.Packages.Table
+ (The_Package).Decl.Variables;
+ Name :=
+ Name_Of (Variable_Node, From_Project_Node_Tree);
while Var_Id /= No_Variable
and then
- Variable_Elements.Table (Var_Id).Name /= Name
+ In_Tree.Variable_Elements.Table
+ (Var_Id).Name /= Name
loop
- Var_Id := Variable_Elements.Table (Var_Id).Next;
+ Var_Id := In_Tree.Variable_Elements.
+ Table (Var_Id).Next;
end loop;
end if;
+ -- If not found in the package, or if there is no
+ -- package, look at the project level.
+
if Var_Id = No_Variable
- and then Package_Node_Of (Variable_Node) = Empty_Node
+ and then
+ No (Package_Node_Of
+ (Variable_Node, From_Project_Node_Tree))
then
- Var_Id := Projects.Table (The_Project).Decl.Variables;
+ Var_Id := The_Project.Decl.Variables;
while Var_Id /= No_Variable
and then
- Variable_Elements.Table (Var_Id).Name /= Name
+ In_Tree.Variable_Elements.Table
+ (Var_Id).Name /= Name
loop
- Var_Id := Variable_Elements.Table (Var_Id).Next;
+ Var_Id := In_Tree.Variable_Elements.
+ Table (Var_Id).Next;
end loop;
end if;
if Var_Id = No_Variable then
- -- Should never happen
+ -- Should never happen, because this has already been
+ -- checked during parsing.
Write_Line ("variable """ &
Get_Name_String (Name) &
raise Program_Error;
end if;
- The_Variable := Variable_Elements.Table (Var_Id).Value;
+ -- Get the case variable
+
+ The_Variable := In_Tree.Variable_Elements.
+ Table (Var_Id).Value;
if The_Variable.Kind /= Single then
- -- Should never happen
+ -- Should never happen, because this has already been
+ -- checked during parsing.
Write_Line ("variable""" &
Get_Name_String (Name) &
raise Program_Error;
end if;
+ -- Get the case variable value
Case_Value := The_Variable.Value;
end;
- Case_Item := First_Case_Item_Of (Current_Item);
+ -- Now look into all the case items of the case construction
+
+ Case_Item :=
+ First_Case_Item_Of (Current_Item, From_Project_Node_Tree);
Case_Item_Loop :
- while Case_Item /= Empty_Node loop
- Choice_String := First_Choice_Of (Case_Item);
+ while Present (Case_Item) loop
+ Choice_String :=
+ First_Choice_Of (Case_Item, From_Project_Node_Tree);
- if Choice_String = Empty_Node then
- Decl_Item := First_Declarative_Item_Of (Case_Item);
+ -- When Choice_String is nil, it means that it is
+ -- the "when others =>" alternative.
+
+ if No (Choice_String) then
+ Decl_Item :=
+ First_Declarative_Item_Of
+ (Case_Item, From_Project_Node_Tree);
exit Case_Item_Loop;
end if;
+ -- Look into all the alternative of this case item
+
Choice_Loop :
- while Choice_String /= Empty_Node loop
- if String_Equal (Case_Value,
- String_Value_Of (Choice_String))
+ while Present (Choice_String) loop
+ if Case_Value =
+ String_Value_Of
+ (Choice_String, From_Project_Node_Tree)
then
Decl_Item :=
- First_Declarative_Item_Of (Case_Item);
+ First_Declarative_Item_Of
+ (Case_Item, From_Project_Node_Tree);
exit Case_Item_Loop;
end if;
Choice_String :=
- Next_Literal_String (Choice_String);
+ Next_Literal_String
+ (Choice_String, From_Project_Node_Tree);
end loop Choice_Loop;
- Case_Item := Next_Case_Item (Case_Item);
+
+ Case_Item :=
+ Next_Case_Item (Case_Item, From_Project_Node_Tree);
end loop Case_Item_Loop;
- if Decl_Item /= Empty_Node then
+ -- If there is an alternative, then we process it
+
+ if Present (Decl_Item) then
Process_Declarative_Items
- (Project => Project,
- From_Project_Node => From_Project_Node,
- Pkg => Pkg,
- Item => Decl_Item);
+ (Project => Project,
+ In_Tree => In_Tree,
+ Flags => Flags,
+ From_Project_Node => From_Project_Node,
+ From_Project_Node_Tree => From_Project_Node_Tree,
+ Pkg => Pkg,
+ Item => Decl_Item);
end if;
end;
-- Should never happen
Write_Line ("Illegal declarative item: " &
- Project_Node_Kind'Image (Kind_Of (Current_Item)));
+ Project_Node_Kind'Image
+ (Kind_Of
+ (Current_Item, From_Project_Node_Tree)));
raise Program_Error;
end case;
end loop;
end Process_Declarative_Items;
- ---------------------
- -- Recursive_Check --
- ---------------------
+ ----------------------------------
+ -- Process_Project_Tree_Phase_1 --
+ ----------------------------------
+
+ procedure Process_Project_Tree_Phase_1
+ (In_Tree : Project_Tree_Ref;
+ Project : out Project_Id;
+ Success : out Boolean;
+ From_Project_Node : Project_Node_Id;
+ From_Project_Node_Tree : Project_Node_Tree_Ref;
+ Flags : Processing_Flags;
+ Reset_Tree : Boolean := True)
+ is
+ begin
+ if Reset_Tree then
+
+ -- Make sure there are no projects in the data structure
+
+ Free_List (In_Tree.Projects, Free_Project => True);
+ end if;
+
+ Processed_Projects.Reset;
- procedure Recursive_Check (Project : Project_Id) is
- Data : Project_Data;
- Imported_Project_List : Project_List := Empty_Project_List;
+ -- And process the main project and all of the projects it depends on,
+ -- recursively.
+
+ Recursive_Process
+ (Project => Project,
+ In_Tree => In_Tree,
+ Flags => Flags,
+ From_Project_Node => From_Project_Node,
+ From_Project_Node_Tree => From_Project_Node_Tree,
+ Extended_By => No_Project);
+
+ Success :=
+ Total_Errors_Detected = 0
+ and then
+ (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
+ end Process_Project_Tree_Phase_1;
+
+ ----------------------------------
+ -- Process_Project_Tree_Phase_2 --
+ ----------------------------------
+
+ procedure Process_Project_Tree_Phase_2
+ (In_Tree : Project_Tree_Ref;
+ Project : Project_Id;
+ Success : out Boolean;
+ From_Project_Node : Project_Node_Id;
+ From_Project_Node_Tree : Project_Node_Tree_Ref;
+ Flags : Processing_Flags)
+ is
+ Obj_Dir : Path_Name_Type;
+ Extending : Project_Id;
+ Extending2 : Project_Id;
+ Prj : Project_List;
+
+ -- Start of processing for Process_Project_Tree_Phase_2
begin
- -- Do nothing if Project is No_Project, or Project has already
- -- been marked as checked.
+ Success := True;
+
+ if Project /= No_Project then
+ Check (In_Tree, Project, Flags);
+ end if;
+
+ -- If main project is an extending all project, set object directory of
+ -- all virtual extending projects to object directory of main project.
if Project /= No_Project
- and then not Projects.Table (Project).Checked
+ and then
+ Is_Extending_All (From_Project_Node, From_Project_Node_Tree)
then
- Data := Projects.Table (Project);
+ declare
+ Object_Dir : constant Path_Name_Type :=
+ Project.Object_Directory.Name;
+ begin
+ Prj := In_Tree.Projects;
+ while Prj /= null loop
+ if Prj.Project.Virtual then
+ Prj.Project.Object_Directory.Name := Object_Dir;
+ end if;
+ Prj := Prj.Next;
+ end loop;
+ end;
+ end if;
- -- Call itself for a possible modified project.
- -- (if there is no modified project, then nothing happens).
+ -- Check that no extending project shares its object directory with
+ -- the project(s) it extends.
- Recursive_Check (Data.Modifies);
+ if Project /= No_Project then
+ Prj := In_Tree.Projects;
+ while Prj /= null loop
+ Extending := Prj.Project.Extended_By;
- -- Call itself for all imported projects
+ if Extending /= No_Project then
+ Obj_Dir := Prj.Project.Object_Directory.Name;
- 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;
+ -- Check that a project being extended does not share its
+ -- object directory with any project that extends it, directly
+ -- or indirectly, including a virtual extending project.
- -- Mark project as checked
+ -- Start with the project directly extending it
- Projects.Table (Project).Checked := True;
+ Extending2 := Extending;
+ while Extending2 /= No_Project loop
+ if Has_Ada_Sources (Extending2)
+ and then Extending2.Object_Directory.Name = Obj_Dir
+ then
+ if Extending2.Virtual then
+ Error_Msg_Name_1 := Prj.Project.Display_Name;
+ Error_Msg
+ (Flags,
+ "project %% cannot be extended by a virtual" &
+ " project with the same object directory",
+ Prj.Project.Location, Project);
- if Opt.Verbose_Mode then
- Write_Str ("Checking project file """);
- Write_Str (Get_Name_String (Data.Name));
- Write_Line ("""");
- end if;
+ else
+ Error_Msg_Name_1 := Extending2.Display_Name;
+ Error_Msg_Name_2 := Prj.Project.Display_Name;
+ Error_Msg
+ (Flags,
+ "project %% cannot extend project %%",
+ Extending2.Location, Project);
+ Error_Msg
+ (Flags,
+ "\they share the same object directory",
+ Extending2.Location, Project);
+ end if;
+ end if;
+
+ -- Continue with the next extending project, if any
+
+ Extending2 := Extending2.Extended_By;
+ end loop;
+ end if;
- Prj.Nmsc.Ada_Check (Project, Error_Report);
+ Prj := Prj.Next;
+ end loop;
end if;
- end Recursive_Check;
+
+ Success :=
+ Total_Errors_Detected = 0
+ and then
+ (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
+ end Process_Project_Tree_Phase_2;
-----------------------
-- Recursive_Process --
-----------------------
procedure Recursive_Process
- (Project : out Project_Id;
- From_Project_Node : Project_Node_Id;
- Modified_By : Project_Id)
+ (In_Tree : Project_Tree_Ref;
+ Project : out Project_Id;
+ Flags : Processing_Flags;
+ From_Project_Node : Project_Node_Id;
+ From_Project_Node_Tree : Project_Node_Tree_Ref;
+ Extended_By : Project_Id)
is
- With_Clause : Project_Node_Id;
+ procedure Process_Imported_Projects
+ (Imported : in out Project_List;
+ Limited_With : Boolean);
+ -- Process imported projects. If Limited_With is True, then only
+ -- projects processed through a "limited with" are processed, otherwise
+ -- only projects imported through a standard "with" are processed.
+ -- Imported is the id of the last imported project.
+
+ -------------------------------
+ -- Process_Imported_Projects --
+ -------------------------------
+
+ procedure Process_Imported_Projects
+ (Imported : in out Project_List;
+ Limited_With : Boolean)
+ is
+ With_Clause : Project_Node_Id;
+ New_Project : Project_Id;
+ Proj_Node : Project_Node_Id;
+
+ begin
+ With_Clause :=
+ First_With_Clause_Of
+ (From_Project_Node, From_Project_Node_Tree);
+ while Present (With_Clause) loop
+ Proj_Node :=
+ Non_Limited_Project_Node_Of
+ (With_Clause, From_Project_Node_Tree);
+ New_Project := No_Project;
+
+ if (Limited_With and then No (Proj_Node))
+ or else (not Limited_With and then Present (Proj_Node))
+ then
+ Recursive_Process
+ (In_Tree => In_Tree,
+ Project => New_Project,
+ Flags => Flags,
+ From_Project_Node =>
+ Project_Node_Of
+ (With_Clause, From_Project_Node_Tree),
+ From_Project_Node_Tree => From_Project_Node_Tree,
+ Extended_By => No_Project);
+
+ -- Imported is the id of the last imported project. If
+ -- it is nil, then this imported project is our first.
+
+ if Imported = null then
+ Project.Imported_Projects :=
+ new Project_List_Element'
+ (Project => New_Project,
+ Next => null);
+ Imported := Project.Imported_Projects;
+ else
+ Imported.Next := new Project_List_Element'
+ (Project => New_Project,
+ Next => null);
+ Imported := Imported.Next;
+ end if;
+ end if;
+
+ With_Clause :=
+ Next_With_Clause_Of (With_Clause, From_Project_Node_Tree);
+ end loop;
+ end Process_Imported_Projects;
+
+ -- Start of processing for Recursive_Process
begin
- if From_Project_Node = Empty_Node then
+ if No (From_Project_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);
+ Imported : Project_List;
+ Declaration_Node : Project_Node_Id := Empty_Node;
+
+ Name : constant Name_Id :=
+ Name_Of (From_Project_Node, From_Project_Node_Tree);
+
+ Name_Node : constant Tree_Private_Part.Project_Name_And_Node :=
+ Tree_Private_Part.Projects_Htable.Get
+ (From_Project_Node_Tree.Projects_HT, Name);
begin
Project := Processed_Projects.Get (Name);
if Project /= No_Project then
+
+ -- Make sure that, when a project is extended, the project id
+ -- of the project extending it is recorded in its data, even
+ -- when it has already been processed as an imported project.
+ -- This is for virtually extended projects.
+
+ if Extended_By /= No_Project then
+ Project.Extended_By := Extended_By;
+ end if;
+
return;
end if;
- Projects.Increment_Last;
- Project := Projects.Last;
+ Project := new Project_Data'(Empty_Project);
+ In_Tree.Projects := new Project_List_Element'
+ (Project => Project,
+ Next => In_Tree.Projects);
+
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;
- Processed_Data.Naming := Standard_Naming_Data;
+ Project.Name := Name;
+ Project.Display_Name := Name_Node.Display_Name;
+ Project.Qualifier :=
+ Project_Qualifier_Of (From_Project_Node, From_Project_Node_Tree);
- Add_Attributes (Processed_Data.Decl, Attribute_First);
- With_Clause := First_With_Clause_Of (From_Project_Node);
+ Get_Name_String (Name);
- while With_Clause /= Empty_Node loop
- declare
- New_Project : Project_Id;
- New_Data : Project_Data;
+ -- If name starts with the virtual prefix, flag the project as
+ -- being a virtual extending project.
- 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;
+ if Name_Len > Virtual_Prefix'Length
+ and then Name_Buffer (1 .. Virtual_Prefix'Length) =
+ Virtual_Prefix
+ then
+ Project.Virtual := True;
- -- Add this project to our list of imported projects
+ end if;
- Project_Lists.Increment_Last;
- Project_Lists.Table (Project_Lists.Last) :=
- (Project => New_Project, Next => Empty_Project_List);
+ Project.Path.Display_Name :=
+ Path_Name_Of (From_Project_Node, From_Project_Node_Tree);
+ Get_Name_String (Project.Path.Display_Name);
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ Project.Path.Name := Name_Find;
- -- Imported is the id of the last imported project.
- -- If it is nil, then this imported project is our first.
+ Project.Location :=
+ Location_Of (From_Project_Node, From_Project_Node_Tree);
- if Imported = Empty_Project_List then
- Processed_Data.Imported_Projects := Project_Lists.Last;
+ Project.Directory.Display_Name :=
+ Directory_Of (From_Project_Node, From_Project_Node_Tree);
+ Get_Name_String (Project.Directory.Display_Name);
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ Project.Directory.Name := Name_Find;
- else
- Project_Lists.Table (Imported).Next := Project_Lists.Last;
- end if;
+ Project.Extended_By := Extended_By;
- Imported := Project_Lists.Last;
+ Add_Attributes
+ (Project,
+ Name,
+ Name_Id (Project.Directory.Name),
+ In_Tree,
+ Project.Decl,
+ Prj.Attr.Attribute_First,
+ Project_Level => True);
- With_Clause := Next_With_Clause_Of (With_Clause);
- end;
- end loop;
+ Process_Imported_Projects (Imported, Limited_With => False);
- Declaration_Node := Project_Declaration_Of (From_Project_Node);
+ Declaration_Node :=
+ Project_Declaration_Of
+ (From_Project_Node, From_Project_Node_Tree);
Recursive_Process
- (Project => Processed_Data.Modifies,
- From_Project_Node => Modified_Project_Of (Declaration_Node),
- Modified_By => Project);
-
- Projects.Table (Project) := Processed_Data;
+ (In_Tree => In_Tree,
+ Project => Project.Extends,
+ Flags => Flags,
+ From_Project_Node => Extended_Project_Of
+ (Declaration_Node,
+ From_Project_Node_Tree),
+ From_Project_Node_Tree => From_Project_Node_Tree,
+ Extended_By => Project);
Process_Declarative_Items
- (Project => Project,
- From_Project_Node => From_Project_Node,
- Pkg => No_Package,
- Item => First_Declarative_Item_Of
- (Declaration_Node));
+ (Project => Project,
+ In_Tree => In_Tree,
+ Flags => Flags,
+ From_Project_Node => From_Project_Node,
+ From_Project_Node_Tree => From_Project_Node_Tree,
+ Pkg => No_Package,
+ Item => First_Declarative_Item_Of
+ (Declaration_Node,
+ From_Project_Node_Tree));
+
+ -- If it is an extending project, inherit all packages
+ -- from the extended project that are not explicitly defined
+ -- or renamed. Also inherit the languages, if attribute Languages
+ -- is not explicitly defined.
+
+ if Project.Extends /= No_Project then
+ declare
+ Extended_Pkg : Package_Id;
+ Current_Pkg : Package_Id;
+ Element : Package_Element;
+ First : constant Package_Id :=
+ Project.Decl.Packages;
+ Attribute1 : Variable_Id;
+ Attribute2 : Variable_Id;
+ Attr_Value1 : Variable;
+ Attr_Value2 : Variable;
+
+ begin
+ Extended_Pkg := Project.Extends.Decl.Packages;
+ while Extended_Pkg /= No_Package loop
+ Element := In_Tree.Packages.Table (Extended_Pkg);
+
+ Current_Pkg := First;
+ while Current_Pkg /= No_Package
+ and then In_Tree.Packages.Table (Current_Pkg).Name /=
+ Element.Name
+ loop
+ Current_Pkg :=
+ In_Tree.Packages.Table (Current_Pkg).Next;
+ end loop;
+
+ if Current_Pkg = No_Package then
+ Package_Table.Increment_Last
+ (In_Tree.Packages);
+ Current_Pkg := Package_Table.Last (In_Tree.Packages);
+ In_Tree.Packages.Table (Current_Pkg) :=
+ (Name => Element.Name,
+ Decl => No_Declarations,
+ Parent => No_Package,
+ Next => Project.Decl.Packages);
+ Project.Decl.Packages := Current_Pkg;
+ Copy_Package_Declarations
+ (From => Element.Decl,
+ To =>
+ In_Tree.Packages.Table (Current_Pkg).Decl,
+ New_Loc => No_Location,
+ Naming_Restricted =>
+ Element.Name = Snames.Name_Naming,
+ In_Tree => In_Tree);
+ end if;
+
+ Extended_Pkg := Element.Next;
+ end loop;
+
+ -- Check if attribute Languages is declared in the
+ -- extending project.
+
+ Attribute1 := Project.Decl.Attributes;
+ while Attribute1 /= No_Variable loop
+ Attr_Value1 := In_Tree.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
+ -- Attribute Languages is not declared in the extending
+ -- project. Check if it is declared in the project being
+ -- extended.
+
+ Attribute2 := Project.Extends.Decl.Attributes;
+ while Attribute2 /= No_Variable loop
+ Attr_Value2 := In_Tree.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
+ -- As attribute Languages is declared in the project
+ -- being extended, copy its value for the extending
+ -- project.
+
+ if Attribute1 = No_Variable then
+ Variable_Element_Table.Increment_Last
+ (In_Tree.Variable_Elements);
+ Attribute1 := Variable_Element_Table.Last
+ (In_Tree.Variable_Elements);
+ Attr_Value1.Next := Project.Decl.Attributes;
+ Project.Decl.Attributes := Attribute1;
+ end if;
+
+ Attr_Value1.Name := Snames.Name_Languages;
+ Attr_Value1.Value := Attr_Value2.Value;
+ In_Tree.Variable_Elements.Table
+ (Attribute1) := Attr_Value1;
+ end if;
+ end if;
+ end;
+ end if;
+ Process_Imported_Projects (Imported, Limited_With => True);
end;
end if;
end Recursive_Process;
OSDN Git Service
