------------------------------------------------------------------------------
--                                                                          --
--                           GPR PROJECT MANAGER                            --
--                                                                          --
--          Copyright (C) 2001-2017, Free Software Foundation, Inc.         --
--                                                                          --
-- This library is free software;  you can redistribute it and/or modify it --
-- under terms of the  GNU General Public License  as published by the Free --
-- Software  Foundation;  either version 3,  or (at your  option) any later --
-- version. This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Containers.Vectors;
with Ada.Strings.Fixed;      use Ada.Strings.Fixed;

with GNAT.Case_Util; use GNAT.Case_Util;
with GNAT.HTable;

with GPR.Attr;    use GPR.Attr;
with GPR.Env;     use GPR.Env;
with GPR.Err;     use GPR.Err;
with GPR.Erroutc; use GPR.Erroutc;
with GPR.Ext;     use GPR.Ext;
with GPR.Names;   use GPR.Names;
with GPR.Nmsc;    use GPR.Nmsc;
with GPR.Opt;     use GPR.Opt;
with GPR.Osint;   use GPR.Osint;
with GPR.Output;  use GPR.Output;
with GPR.Part;
with GPR.Util;
with GPR.Snames;

package body GPR.Proc is

   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

   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

   package Runtime_Defaults is new GNAT.HTable.Simple_HTable
     (Header_Num => GPR.Header_Num,
      Element    => Name_Id,
      No_Element => No_Name,
      Key        => Name_Id,
      Hash       => GPR.Hash,
      Equal      => "=");
   --  Stores the default values of 'Runtime names for the various languages

   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
     (Project       : Project_Id;
      Project_Name  : Name_Id;
      Project_Dir   : Name_Id;
      Shared        : Shared_Project_Tree_Data_Access;
      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;
      Node_Tree : GPR.Tree.Project_Node_Tree_Ref;
      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;
      Restricted : Boolean;
      Shared     : Shared_Project_Tree_Data_Access);
   --  Copy a package declaration From to To for a renamed package. Change the
   --  locations of all the attributes to New_Loc. When Restricted is
   --  True, do not copy attributes Body, Spec, Implementation, Specification
   --  and Linker_Options.

   function Expression
     (Project                : Project_Id;
      Shared                 : Shared_Project_Tree_Data_Access;
      From_Project_Node      : Project_Node_Id;
      From_Project_Node_Tree : Project_Node_Tree_Ref;
      Env                    : GPR.Tree.Environment;
      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_Extended_Project_From
     (Project      : Project_Id;
      With_Name    : Name_Id;
      No_Extending : Boolean := False) return Project_Id;
   --  Find an imported or extended project of Project whose name is With_Name.
   --  When No_Extending is True, do not look for extending projects, returns
   --  the exact project whose name is With_Name.

   function Package_From
     (Project   : Project_Id;
      Shared    : Shared_Project_Tree_Data_Access;
      With_Name : Name_Id) return Package_Id;
   --  Find the package of Project whose name is With_Name

   procedure Process_Declarative_Items
     (Project           : Project_Id;
      In_Tree           : Project_Tree_Ref;
      From_Project_Node : Project_Node_Id;
      Node_Tree         : Project_Node_Tree_Ref;
      Env               : GPR.Tree.Environment;
      Pkg               : Package_Id;
      Item              : Project_Node_Id;
      Child_Env         : in out GPR.Tree.Environment);
   --  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.
   --
   --  Child_Env is the modified environment after seeing declarations like
   --  "for External(...) use" or "for Project_Path use" in aggregate projects.
   --  It should have been initialized first.

   procedure Recursive_Process
     (In_Tree                : Project_Tree_Ref;
      Project                : out Project_Id;
      Packages_To_Check      : String_List_Access;
      From_Project_Node      : Project_Node_Id;
      From_Project_Node_Tree : Project_Node_Tree_Ref;
      Env                    : in out GPR.Tree.Environment;
      Extended_By            : Project_Id;
      From_Encapsulated_Lib  : Boolean;
      On_New_Tree_Loaded     : Tree_Loaded_Callback := null);
   --  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.
   --
   --  Is_Root_Project should be true only for the project that the user
   --  explicitly loaded. In the context of aggregate projects, only that
   --  project is allowed to modify the environment that will be used to load
   --  projects (Child_Env).
   --
   --  From_Encapsulated_Lib is true if we are parsing a project from
   --  encapsulated library dependencies.
   --
   --  If specified, On_New_Tree_Loaded is called after each aggregated project
   --  has been processed succesfully.

   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 Name_Id; Str : Name_Id) is
   begin
      if To_Exp = No_Name or else To_Exp = Empty_String 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_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;

   --------------------
   -- Add_Attributes --
   --------------------

   procedure Add_Attributes
     (Project       : Project_Id;
      Project_Name  : Name_Id;
      Project_Dir   : Name_Id;
      Shared        : Shared_Project_Tree_Data_Access;
      Decl          : in out Declarations;
      First         : Attribute_Node_Id;
      Project_Level : Boolean)
   is
      The_Attribute  : Attribute_Node_Id := First;

   begin
      while The_Attribute /= Empty_Attribute loop
         if Attribute_Kind_Of (The_Attribute) = Single then
            declare
               New_Attribute : Variable_Value;

            begin
               case Variable_Kind_Of (The_Attribute) 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 :=
                       (Project     => Project,
                        Kind        => Single,
                        Location    => No_Location,
                        Default     => True,
                        String_Type => Empty_Project_Node,
                        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 :=
                       (Project     => Project,
                        Kind        => List,
                        Location    => No_Location,
                        Default     => True,
                        String_Type => Empty_Project_Node,
                        Values      => Nil_String);

               end case;

               Variable_Element_Table.Increment_Last
                 (Shared.Variable_Elements);
               Shared.Variable_Elements.Table
                 (Variable_Element_Table.Last (Shared.Variable_Elements)) :=
                 (Next  => Decl.Attributes,
                  Name  => Attribute_Name_Of (The_Attribute),
                  Value => New_Attribute);
               Decl.Attributes :=
                 Variable_Element_Table.Last
                   (Shared.Variable_Elements);
            end;
         end if;

         The_Attribute := Next_Attribute (After => The_Attribute);
      end loop;
   end Add_Attributes;

   -----------
   -- Check --
   -----------

   procedure Check
     (In_Tree   : Project_Tree_Ref;
      Project   : Project_Id;
      Node_Tree : GPR.Tree.Project_Node_Tree_Ref;
      Flags     : Processing_Flags)
   is
   begin
      Process_Naming_Scheme (In_Tree, Project, Node_Tree, Flags);

      --  Set the Other_Part field for the units

      declare
         Source1 : Source_Id;
         Name    : Name_Id;
         Source2 : Source_Id;
         Iter    : Source_Iterator;

      begin
         Unit_Htable.Reset;

         Iter := For_Each_Source (In_Tree);
         loop
            Source1 := GPR.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;
      Restricted : Boolean;
      Shared     : Shared_Project_Tree_Data_Access)
   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 := Shared.Variable_Elements.Table (V1);
         V1  := Var.Next;

         --  Do not copy the value of attribute Linker_Options if Restricted

         if Restricted and then Var.Name = Snames.Name_Linker_Options then
            Var.Value.Values := Nil_String;
         end if;

         --  Remove the Next component

         Var.Next := No_Variable;

         --  Change the location to New_Loc

         Var.Value.Location := New_Loc;
         Variable_Element_Table.Increment_Last (Shared.Variable_Elements);

         --  Put in new declaration

         if To.Attributes = No_Variable then
            To.Attributes :=
              Variable_Element_Table.Last (Shared.Variable_Elements);
         else
            Shared.Variable_Elements.Table (V2).Next :=
              Variable_Element_Table.Last (Shared.Variable_Elements);
         end if;

         V2 := Variable_Element_Table.Last (Shared.Variable_Elements);
         Shared.Variable_Elements.Table (V2) := Var;
      end loop;

      --  Then the associated array attributes

      A1 := From.Arrays;
      while A1 /= No_Array loop
         Arr := Shared.Arrays.Table (A1);
         A1  := Arr.Next;

         --  Remove the Next component

         Arr.Next := No_Array;
         Array_Table.Increment_Last (Shared.Arrays);

         --  Create new Array declaration

         if To.Arrays = No_Array then
            To.Arrays := Array_Table.Last (Shared.Arrays);
         else
            Shared.Arrays.Table (A2).Next :=
              Array_Table.Last (Shared.Arrays);
         end if;

         A2 := Array_Table.Last (Shared.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 := Shared.Array_Elements.Table (E1);
            E1 := Elm.Next;

            --  Remove the Next component

            Elm.Next := No_Array_Element;

            Elm.Restricted := Restricted;

            --  Change the location

            Elm.Value.Location := New_Loc;
            Array_Element_Table.Increment_Last (Shared.Array_Elements);

            --  Create new array element

            if Arr.Value = No_Array_Element then
               Arr.Value := Array_Element_Table.Last (Shared.Array_Elements);
            else
               Shared.Array_Elements.Table (E2).Next :=
                 Array_Element_Table.Last (Shared.Array_Elements);
            end if;

            E2 := Array_Element_Table.Last (Shared.Array_Elements);
            Shared.Array_Elements.Table (E2) := Elm;
         end loop;

         --  Finally, store the new array

         Shared.Arrays.Table (A2) := Arr;
      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
   begin
      if Index = All_Other_Names
        or else not Case_Insensitive (Attr, Tree)
      then
         return Index;
      end if;

      Get_Name_String (Index);
      To_Lower (Name_Buffer (1 .. Name_Len));
      return Name_Find;
   end Get_Attribute_Index;

   ----------------
   -- Expression --
   ----------------

   function Expression
     (Project                : Project_Id;
      Shared                 : Shared_Project_Tree_Data_Access;
      From_Project_Node      : Project_Node_Id;
      From_Project_Node_Tree : Project_Node_Tree_Ref;
      Env                    : GPR.Tree.Environment;
      Pkg                    : Package_Id;
      First_Term             : Project_Node_Id;
      Kind                   : Variable_Kind) return Variable_Value
   is
      The_Term : Project_Node_Id;
      --  The term in the expression list

      The_Current_Term : Project_Node_Id := Empty_Project_Node;
      --  The current term node id

      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

      Current_Term_Kind : Project_Node_Kind;

      procedure Split
        (Source    : Project_Node_Id;
         Separator : Project_Node_Id);
      --  Process N_Split node

      -----------
      -- Split --
      -----------

      procedure Split
        (Source    : Project_Node_Id;
         Separator : Project_Node_Id)
      is
         use GPR.Util;

         Source_Var : constant Variable_Value :=
           Expression
             (Project                => Project,
              Shared                 => Shared,
              From_Project_Node      => Source,
              From_Project_Node_Tree => From_Project_Node_Tree,
              Env                    => Env,
              Pkg                    => Pkg,
              First_Term             =>
                Tree.First_Term (Source, From_Project_Node_Tree),
              Kind                   => Single);

         Separator_Var : constant Variable_Value :=
           Expression
             (Project                => Project,
              Shared                 => Shared,
              From_Project_Node      => Separator,
              From_Project_Node_Tree => From_Project_Node_Tree,
              Env                    => Env,
              Pkg                    => Pkg,
              First_Term             =>
                Tree.First_Term (Separator, From_Project_Node_Tree),
              Kind                   => Single);

         Source_String : constant String :=
           Get_Name_String (Source_Var.Value);
         Separator_String : constant String :=
           Get_Name_String (Separator_Var.Value);

         Names : constant Name_Array_Type :=
           Split (Source    => Source_String,
                  Separator => Separator_String);

      begin
         for J in Names'Range loop
            String_Element_Table.Increment_Last
              (Shared.String_Elements);

            if Last = Nil_String then
               Result.Values :=
                 String_Element_Table.Last
                   (Shared.String_Elements);

            else
               Shared.String_Elements.Table (Last).Next
                 := String_Element_Table.Last
                   (Shared.String_Elements);
            end if;

            Last := String_Element_Table.Last
              (Shared.String_Elements);

            Shared.String_Elements.Table (Last) :=
              (Value         => Names (J),
               Display_Value => No_Name,
               Location      =>
                 Location_Of
                   (The_Current_Term,
                    From_Project_Node_Tree),
               Flag          => False,
               Next          => Nil_String,
               Index         => 0);
         end loop;
      end Split;

   begin
      Result.Project := Project;
      Result.Location := Location_Of (First_Term, From_Project_Node_Tree);

      --  Process each term of the expression, starting with First_Term

      The_Term := First_Term;
      while Present (The_Term) loop
         The_Current_Term := Current_Term (The_Term, From_Project_Node_Tree);

         if The_Current_Term /= Empty_Project_Node then
            Current_Term_Kind :=
              Kind_Of (The_Current_Term, From_Project_Node_Tree);

            case Current_Term_Kind 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, From_Project_Node_Tree));
                     Result.Index :=
                       Source_Index_Of
                         (The_Current_Term, From_Project_Node_Tree);

                  when List =>

                     String_Element_Table.Increment_Last
                       (Shared.String_Elements);

                     if Last = Nil_String then

                        --  This can happen in an expression like () & "toto"

                        Result.Values := String_Element_Table.Last
                          (Shared.String_Elements);

                     else
                        Shared.String_Elements.Table
                          (Last).Next := String_Element_Table.Last
                                           (Shared.String_Elements);
                     end if;

                     Last := String_Element_Table.Last
                               (Shared.String_Elements);

                     Shared.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,
                                     From_Project_Node_Tree);

                  Value : Variable_Value;

               begin
                  if Present (String_Node) then

                     --  If String_Node is nil, it is an empty list, there is
                     --  nothing to do.

                     Value := Expression
                       (Project                => Project,
                        Shared                 => Shared,
                        From_Project_Node      => From_Project_Node,
                        From_Project_Node_Tree => From_Project_Node_Tree,
                        Env                    => Env,
                        Pkg                    => Pkg,
                        First_Term             =>
                          Tree.First_Term
                            (String_Node, From_Project_Node_Tree),
                        Kind                   => Single);
                     String_Element_Table.Increment_Last
                       (Shared.String_Elements);

                     if Result.Values = Nil_String then

                        --  This literal string list is the first term in a
                        --  string list expression

                        Result.Values :=
                          String_Element_Table.Last
                            (Shared.String_Elements);

                     else
                        Shared.String_Elements.Table (Last).Next :=
                          String_Element_Table.Last (Shared.String_Elements);
                     end if;

                     Last :=
                       String_Element_Table.Last (Shared.String_Elements);

                     Shared.String_Elements.Table (Last) :=
                       (Value         => Value.Value,
                        Display_Value => No_Name,
                        Location      => Value.Location,
                        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, From_Project_Node_Tree);

                        exit when No (String_Node);

                        Value :=
                          Expression
                            (Project                => Project,
                             Shared                 => Shared,
                             From_Project_Node      => From_Project_Node,
                             From_Project_Node_Tree => From_Project_Node_Tree,
                             Env                    => Env,
                             Pkg                    => Pkg,
                             First_Term             =>
                               Tree.First_Term
                                 (String_Node, From_Project_Node_Tree),
                             Kind                   => Single);

                        String_Element_Table.Increment_Last
                          (Shared.String_Elements);
                        Shared.String_Elements.Table (Last).Next :=
                          String_Element_Table.Last (Shared.String_Elements);
                        Last := String_Element_Table.Last
                          (Shared.String_Elements);
                        Shared.String_Elements.Table (Last) :=
                          (Value         => Value.Value,
                           Display_Value => No_Name,
                           Location      => Value.Location,
                           Flag          => False,
                           Next          => Nil_String,
                           Index         => Value.Index);
                     end loop;
                  end if;
               end;

            when N_Variable_Reference | N_Attribute_Reference =>
               declare
                  The_Project     : Project_Id  := Project;
                  The_Package     : Package_Id  := Pkg;
                  The_Name        : Name_Id     := No_Name;
                  The_Variable_Id : Variable_Id := No_Variable;
                  The_Variable    : Variable_Value;
                  Term_Project    : constant Project_Node_Id :=
                                      Project_Node_Of
                                        (The_Current_Term,
                                         From_Project_Node_Tree);
                  Term_Package    : constant Project_Node_Id :=
                                      Package_Node_Of
                                        (The_Current_Term,
                                         From_Project_Node_Tree);
                  Index           : Name_Id := No_Name;

               begin
                  <<Object_Dir_Restart>>
                  The_Project := Project;
                  The_Package := Pkg;
                  The_Name := No_Name;
                  The_Variable_Id := No_Variable;
                  Index := No_Name;

                  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, From_Project_Node_Tree);
                     The_Project := Imported_Or_Extended_Project_From
                                      (Project      => Project,
                                       With_Name    => The_Name,
                                       No_Extending => True);
                  end if;

                  if Present (Term_Package) then

                     --  This is an attribute of a package

                     The_Name :=
                       Name_Of (Term_Package, From_Project_Node_Tree);

                     The_Package := The_Project.Decl.Packages;
                     while The_Package /= No_Package
                       and then Shared.Packages.Table (The_Package).Name /=
                                The_Name
                     loop
                        The_Package :=
                          Shared.Packages.Table (The_Package).Next;
                     end loop;

                     pragma Assert
                       (The_Package /= No_Package, "package not found.");

                  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, From_Project_Node_Tree);

                  if Current_Term_Kind = 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_Name then

                     --  It is not an associative array attribute

                     if The_Package /= No_Package then

                        --  First, if there is a package, look into the package

                        if Current_Term_Kind = N_Variable_Reference then
                           The_Variable_Id :=
                             Shared.Packages.Table
                               (The_Package).Decl.Variables;
                        else
                           The_Variable_Id :=
                             Shared.Packages.Table
                               (The_Package).Decl.Attributes;
                        end if;

                        while The_Variable_Id /= No_Variable
                          and then Shared.Variable_Elements.Table
                                     (The_Variable_Id).Name /= The_Name
                        loop
                           The_Variable_Id :=
                             Shared.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 Current_Term_Kind = N_Variable_Reference then
                           The_Variable_Id := The_Project.Decl.Variables;
                        else
                           The_Variable_Id := The_Project.Decl.Attributes;
                        end if;

                        while The_Variable_Id /= No_Variable
                          and then Shared.Variable_Elements.Table
                            (The_Variable_Id).Name /= The_Name
                        loop
                           The_Variable_Id :=
                             Shared.Variable_Elements.Table
                               (The_Variable_Id).Next;
                        end loop;

                     end if;

                     if From_Project_Node_Tree.Incomplete_With then
                        if The_Variable_Id = No_Variable then
                           The_Variable := Nil_Variable_Value;
                        else
                           The_Variable :=
                             Shared.Variable_Elements.Table
                               (The_Variable_Id).Value;
                        end if;

                     else
                        pragma Assert (The_Variable_Id /= No_Variable,
                                       "variable or attribute not found");

                        The_Variable :=
                          Shared.Variable_Elements.Table
                            (The_Variable_Id).Value;
                     end if;

                  else

                     --  It is an associative array attribute

                     declare
                        The_Array   : Array_Id := No_Array;
                        The_Element : Array_Element_Id := No_Array_Element;
                        Array_Index : Name_Id := No_Name;
                        Case_Insens : constant Boolean :=
                          Case_Insensitive
                            (The_Current_Term,
                             From_Project_Node_Tree);

                        function Same_Index
                          (N1 : Name_Id;
                           N2 : Name_Id)
                           return Boolean;
                        --  Return True iff N1 and N2 are the same string with
                        --  the case-insensitivity Case_Insens.

                        ----------------
                        -- Same_Index --
                        ----------------

                        function Same_Index
                          (N1 : Name_Id;
                           N2 : Name_Id)
                           return Boolean
                        is
                        begin
                           if Case_Insens and then
                             N1 /= All_Other_Names and then
                             N2 /= All_Other_Names
                           then
                              declare
                                 Name_1 : String := Get_Name_String (N1);
                                 Name_2 : String := Get_Name_String (N2);
                              begin
                                 To_Lower (Name_1);
                                 To_Lower (Name_2);
                                 return Name_1 = Name_2;
                              end;

                           else
                              return N1 = N2;
                           end if;
                        end Same_Index;

                     begin
                        if The_Package /= No_Package then
                           The_Array :=
                             Shared.Packages.Table (The_Package).Decl.Arrays;
                        else
                           The_Array := The_Project.Decl.Arrays;
                        end if;

                        while The_Array /= No_Array
                          and then
                            Shared.Arrays.Table (The_Array).Name /= The_Name
                        loop
                           The_Array := Shared.Arrays.Table (The_Array).Next;
                        end loop;

                        if The_Array /= No_Array then
                           The_Element :=
                             Shared.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
                               not Same_Index
                                 (Shared.Array_Elements.Table
                                    (The_Element).Index,
                                  Array_Index)
                           loop
                              The_Element :=
                                Shared.Array_Elements.Table (The_Element).Next;
                           end loop;

                        end if;

                        if The_Element /= No_Array_Element then
                           The_Variable :=
                             Shared.Array_Elements.Table (The_Element).Value;

                        else
                           if Expression_Kind_Of
                               (The_Current_Term, From_Project_Node_Tree) =
                                                                       List
                           then
                              The_Variable :=
                                (Project     => Project,
                                 Kind        => List,
                                 Location    => No_Location,
                                 Default     => True,
                                 String_Type => Empty_Project_Node,
                                 Values      => Nil_String);
                           else
                              The_Variable :=
                                (Project     => Project,
                                 Kind        => Single,
                                 Location    => No_Location,
                                 Default     => True,
                                 String_Type => Empty_Project_Node,
                                 Value       => Empty_String,
                                 Index       => 0);
                           end if;
                        end if;
                     end;
                  end if;

                  --  Check the defaults

                  if Current_Term_Kind = N_Attribute_Reference then
                     declare
                        The_Default : constant Attribute_Default_Value :=
                          Default_Of
                            (The_Current_Term, From_Project_Node_Tree);

                     begin
                        --  Check the special value for 'Target when specified

                        if The_Default = Target_Value
                          and then Opt.Target_Origin = Specified
                        then
                           Name_Len := 0;
                           Add_Str_To_Name_Buffer (Opt.Target_Value.all);
                           The_Variable.Value := Name_Find;

                        --  Check special value for Runtime (<lang>): --RTS=
                        --  overrides declaration of Runtime (<lang>).

                        elsif The_Default = Runtime_Value then
                           Get_Name_String (Index);
                           To_Lower (Name_Buffer (1 .. Name_Len));

                           if Runtime_Defaults.Get (Name_Find) /= No_Name then
                              The_Variable.Value :=
                                Runtime_Defaults.Get (Name_Find);
                           end if;

                        --  Check the defaults

                        elsif The_Variable.Default then
                           case The_Variable.Kind is

                           when Undefined =>
                              null;

                           when Single =>
                              case The_Default is
                                 when Read_Only_Value =>
                                    null;

                                 when Empty_Value =>
                                    The_Variable.Value := Empty_String;

                                 when Dot_Value =>
                                    The_Variable.Value := Dot_String;

                                 when Object_Dir_Value =>
                                    From_Project_Node_Tree.Project_Nodes.Table
                                      (The_Current_Term).Name :=
                                      Snames.Name_Object_Dir;
                                    From_Project_Node_Tree.Project_Nodes.Table
                                      (The_Current_Term).Default :=
                                      Dot_Value;
                                    goto Object_Dir_Restart;

                                 when Target_Value =>
                                    if Opt.Target_Value = null then
                                       The_Variable.Value := Empty_String;

                                    else
                                       Name_Len := 0;
                                       Add_Str_To_Name_Buffer
                                         (Opt.Target_Value.all);
                                       The_Variable.Value := Name_Find;
                                    end if;

                                 when Runtime_Value =>
                                    null;
                              end case;

                           when List =>
                              case The_Default is
                                 when Read_Only_Value  =>
                                    null;

                                 when Empty_Value      =>
                                    The_Variable.Values := Nil_String;

                                 when Dot_Value        =>
                                    The_Variable.Values :=
                                      Shared.Dot_String_List;

                                 when Object_Dir_Value |
                                      Target_Value     |
                                      Runtime_Value    =>
                                    null;
                              end case;
                           end case;
                        end if;
                     end;
                  end if;

                  case Kind is
                     when Undefined =>

                        --  This can happen when there are missing withs

                        null;

                     when Single =>
                        case The_Variable.Kind is

                           when Undefined =>
                              null;

                           when Single =>
                              Add (Result.Value, The_Variable.Value);

                           when List =>

                              --  Should never happen

                              pragma Assert
                                (False,
                                 "list cannot appear in single " &
                                 "string expression");
                              null;
                        end case;

                     when List =>
                        case The_Variable.Kind is

                           when Undefined =>
                              null;

                           when Single =>
                              String_Element_Table.Increment_Last
                                (Shared.String_Elements);

                              if Last = Nil_String then

                                 --  This can happen in an expression such as
                                 --  () & Var

                                 Result.Values :=
                                   String_Element_Table.Last
                                     (Shared.String_Elements);

                              else
                                 Shared.String_Elements.Table (Last).Next :=
                                   String_Element_Table.Last
                                     (Shared.String_Elements);
                              end if;

                              Last :=
                                String_Element_Table.Last
                                  (Shared.String_Elements);

                              Shared.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 =>

                              declare
                                 The_List : String_List_Id :=
                                              The_Variable.Values;

                              begin
                                 while The_List /= Nil_String loop
                                    String_Element_Table.Increment_Last
                                      (Shared.String_Elements);

                                    if Last = Nil_String then
                                       Result.Values :=
                                         String_Element_Table.Last
                                           (Shared.String_Elements);

                                    else
                                       Shared.
                                         String_Elements.Table (Last).Next :=
                                         String_Element_Table.Last
                                           (Shared.String_Elements);

                                    end if;

                                    Last :=
                                      String_Element_Table.Last
                                        (Shared.String_Elements);

                                    Shared.String_Elements.Table
                                      (Last) :=
                                      (Value         =>
                                         Shared.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 := Shared.String_Elements.Table
                                                              (The_List).Next;
                                 end loop;
                              end;
                        end case;
                  end case;
               end;

            when N_External_Value =>
               Get_Name_String
                 (String_Value_Of
                    (External_Reference_Of
                       (The_Current_Term, From_Project_Node_Tree),
                     From_Project_Node_Tree));

               declare
                  Name     : constant Name_Id   := Name_Find;
                  Default  : Name_Id            := No_Name;
                  Value    : Name_Id            := No_Name;
                  Ext_List : Boolean            := False;
                  Str_List : String_List_Access := null;
                  Def_Var  : Variable_Value;

                  Default_Node : constant Project_Node_Id :=
                                   External_Default_Of
                                     (The_Current_Term,
                                      From_Project_Node_Tree);

               begin
                  --  If there is a default value for the external reference,
                  --  get its value.

                  if Present (Default_Node) then
                     Def_Var := Expression
                       (Project                => Project,
                        Shared                 => Shared,
                        From_Project_Node      => From_Project_Node,
                        From_Project_Node_Tree => From_Project_Node_Tree,
                        Env                    => Env,
                        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;

                  Ext_List := Expression_Kind_Of
                                (The_Current_Term,
                                 From_Project_Node_Tree) = List;

                  if Ext_List then
                     Value :=
                       GPR.Ext.Value_Of (Env.External, Name, No_Name);

                     if Value /= No_Name then
                        declare
                           Sep   : constant String :=
                                     Get_Name_String (Default);
                           First : Positive := 1;
                           Lst   : Natural;
                           Done  : Boolean := False;
                           Nmb   : Natural;

                        begin
                           Get_Name_String (Value);

                           if Name_Len = 0
                             or else Sep'Length = 0
                             or else Name_Buffer (1 .. Name_Len) = Sep
                           then
                              Done := True;
                           end if;

                           if not Done and then Name_Len < Sep'Length then
                              Str_List :=
                                new String_List'
                                  (1 => new String'
                                       (Name_Buffer (1 .. Name_Len)));
                              Done := True;
                           end if;

                           if not Done then
                              if Name_Buffer (1 .. Sep'Length) = Sep then
                                 First := Sep'Length + 1;
                              end if;

                              if Name_Len - First + 1 >= Sep'Length
                                and then
                                  Name_Buffer (Name_Len - Sep'Length + 1 ..
                                                   Name_Len) = Sep
                              then
                                 Name_Len := Name_Len - Sep'Length;
                              end if;

                              if Name_Len = 0 then
                                 Str_List :=
                                   new String_List'(1 => new String'(""));
                                 Done := True;
                              end if;
                           end if;

                           if not Done then

                              --  Count the number of strings

                              declare
                                 Saved : constant Positive := First;

                              begin
                                 Nmb := 1;
                                 loop
                                    Lst :=
                                      Index
                                        (Source  =>
                                             Name_Buffer (First .. Name_Len),
                                         Pattern => Sep);
                                    exit when Lst = 0;
                                    Nmb := Nmb + 1;
                                    First := Lst + Sep'Length;
                                 end loop;

                                 First := Saved;
                              end;

                              Str_List := new String_List (1 .. Nmb);

                              --  Populate the string list

                              Nmb := 1;
                              loop
                                 Lst :=
                                   Index
                                     (Source  =>
                                          Name_Buffer (First .. Name_Len),
                                      Pattern => Sep);

                                 if Lst = 0 then
                                    Str_List (Nmb) :=
                                      new String'
                                        (Name_Buffer (First .. Name_Len));
                                    exit;

                                 else
                                    Str_List (Nmb) :=
                                      new String'
                                        (Name_Buffer (First .. Lst - 1));
                                    Nmb := Nmb + 1;
                                    First := Lst + Sep'Length;
                                 end if;
                              end loop;
                           end if;
                        end;
                     end if;

                  else
                     --  Get the value

                     Value :=
                       GPR.Ext.Value_Of (Env.External, Name, Default);

                     --  It is an error if an external reference is not found
                     --  and there is no default.

                     if Value = No_Name then

                        --  The name of the external reference needs to be
                        --  displayed verbatim and between double quotes.

                        Get_Name_String (Name);

                        for J in reverse 1 .. Name_Len loop
                           Name_Buffer (J * 2) := Name_Buffer (J);
                           Name_Buffer (J * 2 - 1) := ''';
                        end loop;

                        Name_Len := Name_Len * 2;

                        Error_Msg
                          (Env.Flags,
                           "undefined external reference `" &
                           Name_Buffer (1 .. Name_Len) & "`",
                           Location_Of
                             (The_Current_Term, From_Project_Node_Tree),
                           Project);

                        Value := Empty_String;
                     end if;
                  end if;

                  case Kind is

                     when Undefined =>
                        null;

                     when Single =>
                        if Ext_List then
                           null; -- error

                        else
                           Add (Result.Value, Value);
                        end if;

                     when List =>
                        if not Ext_List or else Str_List /= null then
                           String_Element_Table.Increment_Last
                             (Shared.String_Elements);

                           if Last = Nil_String then
                              Result.Values :=
                                String_Element_Table.Last
                                  (Shared.String_Elements);

                           else
                              Shared.String_Elements.Table (Last).Next
                                := String_Element_Table.Last
                                  (Shared.String_Elements);
                           end if;

                           Last := String_Element_Table.Last
                             (Shared.String_Elements);

                           if Ext_List then
                              for Ind in Str_List'Range loop
                                 Name_Len := 0;
                                 Add_Str_To_Name_Buffer (Str_List (Ind).all);
                                 Value := Name_Find;
                                 Shared.String_Elements.Table (Last) :=
                                   (Value         => Value,
                                    Display_Value => No_Name,
                                    Location      =>
                                      Location_Of
                                        (The_Current_Term,
                                         From_Project_Node_Tree),
                                    Flag          => False,
                                    Next          => Nil_String,
                                    Index         => 0);

                                 if Ind /= Str_List'Last then
                                    String_Element_Table.Increment_Last
                                      (Shared.String_Elements);
                                    Shared.String_Elements.Table (Last).Next :=
                                         String_Element_Table.Last
                                           (Shared.String_Elements);
                                    Last := String_Element_Table.Last
                                              (Shared.String_Elements);
                                 end if;
                              end loop;

                           else
                              Shared.String_Elements.Table (Last) :=
                                (Value         => Value,
                                 Display_Value => No_Name,
                                 Location      =>
                                   Location_Of
                                     (The_Current_Term,
                                      From_Project_Node_Tree),
                                 Flag          => False,
                                 Next          => Nil_String,
                                 Index         => 0);
                           end if;
                        end if;
                  end case;
               end;

            when N_Split =>
               Split
                 (Source =>
                     String_Argument_Of
                    (The_Current_Term,
                     From_Project_Node_Tree),
                  Separator =>
                     Separator_Of
                    (The_Current_Term,
                     From_Project_Node_Tree));

            when others =>

               --  Should never happen

               pragma Assert
                 (False,
                  "illegal node kind in an expression");
               raise Program_Error;

            end case;
         end if;

         The_Term := Next_Term (The_Term, From_Project_Node_Tree);
      end loop;

      return Result;
   end Expression;

   ---------------------------------------
   -- Imported_Or_Extended_Project_From --
   ---------------------------------------

   function Imported_Or_Extended_Project_From
     (Project      : Project_Id;
      With_Name    : Name_Id;
      No_Extending : Boolean := False) return Project_Id
   is
      List        : Project_List;
      Result      : Project_Id;
      Temp_Result : Project_Id;

   begin
      --  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;

      --  Then check the name of each imported project

      Temp_Result := No_Project;
      List := Project.Imported_Projects;
      while List /= null loop
         Result := List.Project;

         --  If the project is directly imported, then returns its ID

         if Result.Name = With_Name then
            return Result;
         end if;

         --  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.

         declare
            Proj : Project_Id;

         begin
            Proj := Result.Extends;
            while Proj /= No_Project loop
               if Proj.Name = With_Name then
                  if No_Extending then
                     Temp_Result := Proj;
                  else
                     Temp_Result := Result;
                  end if;

                  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;
      Shared    : Shared_Project_Tree_Data_Access;
      With_Name : Name_Id) return Package_Id
   is
      Result : Package_Id := Project.Decl.Packages;

   begin
      --  Check the name of each existing package of Project

      while Result /= No_Package
        and then Shared.Packages.Table (Result).Name /= With_Name
      loop
         Result := Shared.Packages.Table (Result).Next;
      end loop;

      if Result = No_Package then
         GPR.Osint.Fail
           ("no package " &
            Get_Name_String (With_Name) &
            " in project " &
            Get_Name_String (Project.Display_Name));

      else
         return Result;
      end if;
   end Package_From;

   -------------
   -- Process --
   -------------

   procedure Process
     (In_Tree                : Project_Tree_Ref;
      Project                : out Project_Id;
      Packages_To_Check      : String_List_Access;
      Success                : out Boolean;
      From_Project_Node      : Project_Node_Id;
      From_Project_Node_Tree : Project_Node_Tree_Ref;
      Env                    : in out GPR.Tree.Environment;
      Reset_Tree             : Boolean              := True;
      On_New_Tree_Loaded     : Tree_Loaded_Callback := null)
   is
   begin
      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,
         Env                    => Env,
         Packages_To_Check      => Packages_To_Check,
         Reset_Tree             => Reset_Tree,
         On_New_Tree_Loaded     => On_New_Tree_Loaded);

      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,
            Env                    => Env);
      end if;
   end Process;

   -------------------------------
   -- Process_Declarative_Items --
   -------------------------------

   procedure Process_Declarative_Items
     (Project           : Project_Id;
      In_Tree           : Project_Tree_Ref;
      From_Project_Node : Project_Node_Id;
      Node_Tree         : Project_Node_Tree_Ref;
      Env               : GPR.Tree.Environment;
      Pkg               : Package_Id;
      Item              : Project_Node_Id;
      Child_Env         : in out GPR.Tree.Environment)
   is
      Shared : constant Shared_Project_Tree_Data_Access := In_Tree.Shared;

      procedure Check_Or_Set_Typed_Variable
        (Value       : in out Variable_Value;
         Declaration : Project_Node_Id);
      --  Check whether Value is valid for this typed variable declaration. If
      --  it is an error, the behavior depends on the flags: either an error is
      --  reported, or a warning, or nothing. In the last two cases, the value
      --  of the variable is set to a valid value, replacing Value.

      procedure Process_Package_Declaration
        (Current_Item : Project_Node_Id);
      procedure Process_Attribute_Declaration
        (Current : Project_Node_Id);
      procedure Process_Case_Construction
        (Current_Item : Project_Node_Id);
      procedure Process_Associative_Array
        (Current_Item : Project_Node_Id);
      procedure Process_Expression
        (Current : Project_Node_Id);
      procedure Process_Expression_For_Associative_Array
        (Current : Project_Node_Id;
         New_Value    : Variable_Value);
      procedure Process_Expression_Variable_Decl
        (Current_Item : Project_Node_Id;
         New_Value    : Variable_Value);
      --  Process the various declarative items

      ---------------------------------
      -- Check_Or_Set_Typed_Variable --
      ---------------------------------

      procedure Check_Or_Set_Typed_Variable
        (Value       : in out Variable_Value;
         Declaration : Project_Node_Id)
      is
         Loc : constant Source_Ptr := Location_Of (Declaration, Node_Tree);

         Reset_Value    : Boolean := False;
         Current_String : Project_Node_Id;

      begin
         --  Report an error for an empty string

         if Value.Kind = Undefined or else Value.Value = Empty_String then
            Error_Msg_Name_1 := Name_Of (Declaration, Node_Tree);

            case Env.Flags.Allow_Invalid_External is
               when Error =>
                  Error_Msg
                    (Env.Flags, "no value defined for %%", Loc, Project);
               when Warning =>
                  Reset_Value := True;
                  Error_Msg
                    (Env.Flags, "?no value defined for %%", Loc, Project);
               when Silent =>
                  Reset_Value := True;
            end case;

         else
            --  Loop through all the valid strings for the
            --  string type and compare to the string value.

            declare
               Str_Type : constant Project_Node_Id :=
                 String_Type_Of (Declaration, Node_Tree);
            begin
               if No (Str_Type) then
                  Current_String := Empty_Project_Node;

               else
                  Current_String := First_Literal_String (Str_Type, Node_Tree);
               end if;

               while Present (Current_String)
                 and then
                   String_Value_Of (Current_String, Node_Tree) /= Value.Value
               loop
                  Current_String :=
                    Next_Literal_String (Current_String, Node_Tree);
               end loop;

               --  Report error if string value is not one for the string type

               if No (Current_String) then
                  Error_Msg_Name_1 := Value.Value;
                  Error_Msg_Name_2 := Name_Of (Declaration, Node_Tree);

                  case Env.Flags.Allow_Invalid_External is
                  when Error =>
                     Error_Msg
                       (Env.Flags, "value %% is illegal for typed string %%",
                        Loc, Project);

                  when Warning =>
                     Error_Msg
                       (Env.Flags, "?value %% is illegal for typed string %%",
                        Loc, Project);
                     Reset_Value := True;

                  when Silent =>
                     Reset_Value := True;
                  end case;

               else
                  Value.String_Type := String_Type_Of (Declaration, Node_Tree);
               end if;
            end;
         end if;

         if Value.Kind /= Undefined and then Reset_Value then
            Current_String :=
              First_Literal_String
                (String_Type_Of (Declaration, Node_Tree), Node_Tree);
            Value.Value := String_Value_Of (Current_String, Node_Tree);
         end if;
      end Check_Or_Set_Typed_Variable;

      ---------------------------------
      -- Process_Package_Declaration --
      ---------------------------------

      procedure Process_Package_Declaration
        (Current_Item : Project_Node_Id)
      is
      begin
         --  Do not process a package declaration that should be ignored

         if Expression_Kind_Of (Current_Item, Node_Tree) /= Ignored then

            --  Create the new package

            Package_Table.Increment_Last (Shared.Packages);

            declare
               New_Pkg         : constant Package_Id :=
                                  Package_Table.Last (Shared.Packages);
               The_New_Package : Package_Element;

               Project_Of_Renamed_Package : constant Project_Node_Id :=
                                              Project_Of_Renamed_Package_Of
                                                (Current_Item, Node_Tree);

            begin
               --  Set the name of the new package

               The_New_Package.Name := Name_Of (Current_Item, Node_Tree);

               --  Insert the new package in the appropriate list

               if Pkg /= No_Package then
                  The_New_Package.Next :=
                    Shared.Packages.Table (Pkg).Decl.Packages;
                  Shared.Packages.Table (Pkg).Decl.Packages := New_Pkg;

               else
                  The_New_Package.Next  := Project.Decl.Packages;
                  Project.Decl.Packages := New_Pkg;
               end if;

               Shared.Packages.Table (New_Pkg) := The_New_Package;

               if Present (Project_Of_Renamed_Package) then

                  --  Renamed or extending package

                  declare
                     Project_Name : constant Name_Id :=
                                      Name_Of (Project_Of_Renamed_Package,
                                               Node_Tree);

                     Renamed_Project : constant Project_Id :=
                                         Imported_Or_Extended_Project_From
                                           (Project, Project_Name);

                     Renamed_Package : constant Package_Id :=
                                         Package_From
                                           (Renamed_Project, Shared,
                                            Name_Of (Current_Item, Node_Tree));

                  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       => Shared.Packages.Table
                                        (Renamed_Package).Decl,
                        To         => Shared.Packages.Table (New_Pkg).Decl,
                        New_Loc    => Location_Of (Current_Item, Node_Tree),
                        Restricted => False,
                        Shared     => Shared);
                  end;

               else
                  --  Set the default values of the attributes

                  Add_Attributes
                    (Project,
                     Project.Name,
                     Name_Id (Project.Directory.Display_Name),
                     Shared,
                     Shared.Packages.Table (New_Pkg).Decl,
                     First_Attribute_Of
                       (Package_Id_Of (Current_Item, Node_Tree)),
                     Project_Level => False);
               end if;

               --  Process declarative items (nothing to do when the package is
               --  renaming, as the first declarative item is null).

               Process_Declarative_Items
                 (Project                => Project,
                  In_Tree                => In_Tree,
                  From_Project_Node      => From_Project_Node,
                  Node_Tree              => Node_Tree,
                  Env                    => Env,
                  Pkg                    => New_Pkg,
                  Item                   =>
                    First_Declarative_Item_Of (Current_Item, Node_Tree),
                  Child_Env              => Child_Env);
            end;
         end if;
      end Process_Package_Declaration;

      -------------------------------
      -- Process_Associative_Array --
      -------------------------------

      procedure Process_Associative_Array
        (Current_Item : Project_Node_Id)
      is
         Current_Item_Name : constant Name_Id :=
                               Name_Of (Current_Item, Node_Tree);
         --  The name of the attribute

         Current_Location  : constant Source_Ptr :=
                               Location_Of (Current_Item, Node_Tree);

         New_Array : Array_Id;
         --  The new associative array created

         Orig_Array : Array_Id;
         --  The associative array value

         Orig_Project_Name : Name_Id := No_Name;
         --  The name of the project where the associative array
         --  value is.

         Orig_Project : Project_Id := No_Project;
         --  The id of the project where the associative array
         --  value is.

         Orig_Package_Name : Name_Id := No_Name;
         --  The name of the package, if any, where the associative array value
         --  is located.

         Orig_Package : Package_Id := No_Package;
         --  The id of the package, if any, where the associative array value
         --  is located.

         New_Element : Array_Element_Id := No_Array_Element;
         --  Id of a new array element created

         Prev_Element : Array_Element_Id := No_Array_Element;
         --  Last new element id created

         Orig_Element : Array_Element_Id := No_Array_Element;
         --  Current array element in original associative array

         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.

         Prj : Project_List;

      begin
         --  First find if the associative array attribute already has elements
         --  declared.

         if Pkg /= No_Package then
            New_Array := Shared.Packages.Table (Pkg).Decl.Arrays;
         else
            New_Array := Project.Decl.Arrays;
         end if;

         while New_Array /= No_Array
           and then Shared.Arrays.Table (New_Array).Name /= Current_Item_Name
         loop
            New_Array := Shared.Arrays.Table (New_Array).Next;
         end loop;

         --  If the attribute has never been declared add new entry in the
         --  arrays of the project/package and link it.

         if New_Array = No_Array then
            Array_Table.Increment_Last (Shared.Arrays);
            New_Array := Array_Table.Last (Shared.Arrays);

            if Pkg /= No_Package then
               Shared.Arrays.Table (New_Array) :=
                 (Name     => Current_Item_Name,
                  Location => Current_Location,
                  Value    => No_Array_Element,
                  Next     => Shared.Packages.Table (Pkg).Decl.Arrays);

               Shared.Packages.Table (Pkg).Decl.Arrays := New_Array;

            else
               Shared.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, Node_Tree), 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, Node_Tree)) then
            Orig_Array := Orig_Project.Decl.Arrays;

         else
            --  If in a package, find the package where the value is declared

            Orig_Package_Name :=
              Name_Of
                (Associative_Package_Of (Current_Item, Node_Tree), Node_Tree);

            Orig_Package := Orig_Project.Decl.Packages;
            pragma Assert (Orig_Package /= No_Package,
                           "original package not found");

            while Shared.Packages.Table
              (Orig_Package).Name /= Orig_Package_Name
            loop
               Orig_Package := Shared.Packages.Table (Orig_Package).Next;
               pragma Assert (Orig_Package /= No_Package,
                              "original package not found");
            end loop;

            Orig_Array := Shared.Packages.Table (Orig_Package).Decl.Arrays;
         end if;

         --  Now look for the array

         while Orig_Array /= No_Array
           and then Shared.Arrays.Table (Orig_Array).Name /= Current_Item_Name
         loop
            Orig_Array := Shared.Arrays.Table (Orig_Array).Next;
         end loop;

         if Orig_Array = No_Array then
            Error_Msg
              (Env.Flags,
               "associative array value not found",
               Location_Of (Current_Item, Node_Tree),
               Project);

         else
            Orig_Element := Shared.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 Shared.Arrays.Table (New_Array).Value =
                    No_Array_Element
                  then
                     Array_Element_Table.Increment_Last
                       (Shared.Array_Elements);
                     New_Element := Array_Element_Table.Last
                       (Shared.Array_Elements);
                     Shared.Arrays.Table (New_Array).Value := New_Element;
                     Next_Element := No_Array_Element;

                     --  Otherwise, the new element is the first

                  else
                     New_Element := Shared.Arrays.Table (New_Array).Value;
                     Next_Element :=
                       Shared.Array_Elements.Table (New_Element).Next;
                  end if;

                  --  Otherwise, reuse an existing element, or create
                  --  one if necessary.

               else
                  Next_Element :=
                    Shared.Array_Elements.Table (Prev_Element).Next;

                  if Next_Element = No_Array_Element then
                     Array_Element_Table.Increment_Last
                       (Shared.Array_Elements);
                     New_Element := Array_Element_Table.Last
                       (Shared.Array_Elements);
                     Shared.Array_Elements.Table (Prev_Element).Next :=
                       New_Element;

                  else
                     New_Element := Next_Element;
                     Next_Element :=
                       Shared.Array_Elements.Table (New_Element).Next;
                  end if;
               end if;

               --  Copy the value of the element

               Shared.Array_Elements.Table (New_Element) :=
                 Shared.Array_Elements.Table (Orig_Element);
               Shared.Array_Elements.Table (New_Element).Value.Project
                 := Project;

               --  Adjust the Next link

               Shared.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 := Shared.Array_Elements.Table (Orig_Element).Next;
            end loop;

            --  Make sure that the array ends here, in case there previously a
            --  greater number of elements.

            Shared.Array_Elements.Table (New_Element).Next := No_Array_Element;
         end if;
      end Process_Associative_Array;

      ----------------------------------------------
      -- Process_Expression_For_Associative_Array --
      ----------------------------------------------

      procedure Process_Expression_For_Associative_Array
        (Current   : Project_Node_Id;
         New_Value : Variable_Value)
      is
         Name             : constant Name_Id := Name_Of (Current, Node_Tree);
         Current_Location : constant Source_Ptr :=
                              Location_Of (Current, Node_Tree);

         Index_Name : Name_Id :=
                        Associative_Array_Index_Of (Current, Node_Tree);

         Source_Index : constant Int :=
                          Source_Index_Of (Current, Node_Tree);

         The_Array : Array_Id;
         Elem      : Array_Element_Id := No_Array_Element;

      begin
         if Index_Name /= All_Other_Names then
            Index_Name := Get_Attribute_Index (Node_Tree, Current, Index_Name);
         end if;

         --  Look for the array in the appropriate list

         if Pkg /= No_Package then
            The_Array := Shared.Packages.Table (Pkg).Decl.Arrays;
         else
            The_Array := Project.Decl.Arrays;
         end if;

         while The_Array /= No_Array
           and then Shared.Arrays.Table (The_Array).Name /= Name
         loop
            The_Array := Shared.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 (Shared.Arrays);
            The_Array := Array_Table.Last (Shared.Arrays);

            if Pkg /= No_Package then
               Shared.Arrays.Table (The_Array) :=
                 (Name     => Name,
                  Location => Current_Location,
                  Value    => No_Array_Element,
                  Next     => Shared.Packages.Table (Pkg).Decl.Arrays);

               Shared.Packages.Table (Pkg).Decl.Arrays := The_Array;

            else
               Shared.Arrays.Table (The_Array) :=
                 (Name     => Name,
                  Location => Current_Location,
                  Value    => No_Array_Element,
                  Next     => Project.Decl.Arrays);

               Project.Decl.Arrays := The_Array;
            end if;

         else
            Elem := Shared.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 Elem /= No_Array_Element
           and then
             (Shared.Array_Elements.Table (Elem).Index /= Index_Name
               or else
                 Shared.Array_Elements.Table (Elem).Src_Index /= Source_Index)
         loop
            Elem := Shared.Array_Elements.Table (Elem).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 Elem = No_Array_Element then
            Array_Element_Table.Increment_Last (Shared.Array_Elements);
            Elem := Array_Element_Table.Last (Shared.Array_Elements);

            Shared.Array_Elements.Table
              (Elem) :=
              (Index                => Index_Name,
               Restricted           => False,
               Src_Index            => Source_Index,
               Index_Case_Sensitive =>
                  not Case_Insensitive (Current, Node_Tree),
               Value                => New_Value,
               Next                 => Shared.Arrays.Table (The_Array).Value);

            Shared.Arrays.Table (The_Array).Value := Elem;

         else
            --  An element with the same index already exists, just replace its
            --  value with the new one.

            Shared.Array_Elements.Table (Elem).Value := New_Value;
         end if;

         if Name = Snames.Name_External then
            if In_Tree.Is_Root_Tree then
               Add (Child_Env.External,
                    External_Name => Get_Name_String (Index_Name),
                    Value         => Get_Name_String (New_Value.Value),
                    Source        => From_External_Attribute);
               Add (Env.External,
                    External_Name => Get_Name_String (Index_Name),
                    Value         => Get_Name_String (New_Value.Value),
                    Source        => From_External_Attribute,
                    Silent        => True);
            else
               if Current_Verbosity = High then
                  Debug_Output
                    ("'for External' has no effect except in root aggregate ("
                     & Get_Name_String (Index_Name) & ")", New_Value.Value);
               end if;
            end if;
         end if;
      end Process_Expression_For_Associative_Array;

      --------------------------------------
      -- Process_Expression_Variable_Decl --
      --------------------------------------

      procedure Process_Expression_Variable_Decl
        (Current_Item : Project_Node_Id;
         New_Value    : Variable_Value)
      is
         Name : constant Name_Id := Name_Of (Current_Item, Node_Tree);

         Is_Attribute : constant Boolean :=
                          Kind_Of (Current_Item, Node_Tree) =
                            N_Attribute_Declaration;

         Var  : Variable_Id := No_Variable;

      begin
         --  First, find the list where to find the variable or attribute

         if Is_Attribute then
            if Pkg /= No_Package then
               Var := Shared.Packages.Table (Pkg).Decl.Attributes;
            else
               Var := Project.Decl.Attributes;
            end if;

         else
            if Pkg /= No_Package then
               Var := Shared.Packages.Table (Pkg).Decl.Variables;
            else
               Var := Project.Decl.Variables;
            end if;
         end if;

         --  Loop through the list, to find if it has already been declared

         while Var /= No_Variable
           and then Shared.Variable_Elements.Table (Var).Name /= Name
         loop
            Var := Shared.Variable_Elements.Table (Var).Next;
         end loop;

         --  If it has not been declared, create a new entry in the list

         if Var = No_Variable then

            --  All single string attribute should already have been declared
            --  with a default empty string value.

            pragma Assert
              (not Is_Attribute,
               "illegal attribute declaration for " & Get_Name_String (Name));

            Variable_Element_Table.Increment_Last (Shared.Variable_Elements);
            Var := Variable_Element_Table.Last (Shared.Variable_Elements);

            --  Put the new variable in the appropriate list

            if Pkg /= No_Package then
               Shared.Variable_Elements.Table (Var) :=
                 (Next   => Shared.Packages.Table (Pkg).Decl.Variables,
                  Name   => Name,
                  Value  => New_Value);
               Shared.Packages.Table (Pkg).Decl.Variables := Var;

            else
               Shared.Variable_Elements.Table (Var) :=
                 (Next   => Project.Decl.Variables,
                  Name   => Name,
                  Value  => New_Value);
               Project.Decl.Variables := Var;
            end if;

            --  If the variable/attribute has already been declared, just
            --  change the value.

         else
            Shared.Variable_Elements.Table (Var).Value := New_Value;
         end if;

         if Is_Attribute and then Name = Snames.Name_Project_Path then
            if In_Tree.Is_Root_Tree then
               declare
                  package Name_Ids is
                    new Ada.Containers.Vectors (Positive, Name_Id);
                  Val  : String_List_Id := New_Value.Values;
                  List : Name_Ids.Vector;
               begin
                  --  Get all values

                  while Val /= Nil_String loop
                     List.Prepend
                       (Shared.String_Elements.Table (Val).Value);
                     Val := Shared.String_Elements.Table (Val).Next;
                  end loop;

                  --  Prepend them in the order found in the attribute

                  for K in Positive range 1 .. Positive (List.Length) loop
                     GPR.Env.Add_Directories
                       (Child_Env.Project_Path,
                        Normalize_Pathname
                          (Name      => Get_Name_String
                             (List.Element (K)),
                           Directory => Get_Name_String
                             (Project.Directory.Display_Name)),
                        Prepend => True);
                  end loop;
               end;

            else
               if Current_Verbosity = High then
                  Debug_Output
                    ("'for Project_Path' has no effect except in"
                     & " root aggregate");
               end if;
            end if;
         end if;
      end Process_Expression_Variable_Decl;

      ------------------------
      -- Process_Expression --
      ------------------------

      procedure Process_Expression (Current : Project_Node_Id) is
         New_Value : Variable_Value :=
                       Expression
                         (Project                => Project,
                          Shared                 => Shared,
                          From_Project_Node      => From_Project_Node,
                          From_Project_Node_Tree => Node_Tree,
                          Env                    => Env,
                          Pkg                    => Pkg,
                          First_Term             =>
                            Tree.First_Term
                              (Expression_Of (Current, Node_Tree), Node_Tree),
                          Kind                 =>
                            Expression_Kind_Of (Current, Node_Tree));

      begin
         --  Process a typed variable declaration

         if Kind_Of (Current, Node_Tree) = N_Typed_Variable_Declaration then
            Check_Or_Set_Typed_Variable (New_Value, Current);
         end if;

         if Kind_Of (Current, Node_Tree) /= N_Attribute_Declaration
           or else Associative_Array_Index_Of (Current, Node_Tree) = No_Name
         then
            Process_Expression_Variable_Decl (Current, New_Value);
         else
            Process_Expression_For_Associative_Array (Current, New_Value);
         end if;
      end Process_Expression;

      -----------------------------------
      -- Process_Attribute_Declaration --
      -----------------------------------

      procedure Process_Attribute_Declaration (Current : Project_Node_Id) is
      begin
         if Expression_Of (Current, Node_Tree) = Empty_Project_Node then
            Process_Associative_Array (Current);
         else
            Process_Expression (Current);
         end if;
      end Process_Attribute_Declaration;

      -------------------------------
      -- Process_Case_Construction --
      -------------------------------

      procedure Process_Case_Construction
        (Current_Item : Project_Node_Id)
      is
         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_Project_Node;
         Choice_String : Project_Node_Id := Empty_Project_Node;
         Decl_Item     : Project_Node_Id := Empty_Project_Node;

      begin
         declare
            Variable_Node : constant Project_Node_Id :=
              Case_Variable_Reference_Of
                (Current_Item,
                 Node_Tree);

            Var_Id : Variable_Id := No_Variable;
            Name   : Name_Id     := No_Name;

         begin
            --  If a project was specified for the case variable, get its id

            if Present (Project_Node_Of (Variable_Node, Node_Tree)) then
               Name :=
                 Name_Of
                   (Project_Node_Of (Variable_Node, Node_Tree), Node_Tree);
               The_Project :=
                 Imported_Or_Extended_Project_From
                   (Project, Name, No_Extending => True);
               The_Package := No_Package;
            end if;

            --  If a package was specified for the case variable, get its id

            if Present (Package_Node_Of (Variable_Node, Node_Tree)) then
               Name :=
                 Name_Of
                   (Package_Node_Of (Variable_Node, Node_Tree), Node_Tree);
               The_Package := Package_From (The_Project, Shared, Name);
            end if;

            Name := Name_Of (Variable_Node, Node_Tree);

            --  First, look for the case variable into the package, if any

            if The_Package /= No_Package then
               Name := Name_Of (Variable_Node, Node_Tree);

               Var_Id := Shared.Packages.Table (The_Package).Decl.Variables;
               while Var_Id /= No_Variable
                 and then Shared.Variable_Elements.Table (Var_Id).Name /= Name
               loop
                  Var_Id := Shared.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 No (Package_Node_Of (Variable_Node, Node_Tree))
            then
               Var_Id := The_Project.Decl.Variables;
               while Var_Id /= No_Variable
                 and then Shared.Variable_Elements.Table (Var_Id).Name /= Name
               loop
                  Var_Id := Shared.Variable_Elements.Table (Var_Id).Next;
               end loop;
            end if;

            if Var_Id = No_Variable then
               if Node_Tree.Incomplete_With then
                  return;

               --  Should never happen, because this has already been checked
               --  during parsing.

               else
                  Write_Line
                    ("variable """ & Get_Name_String (Name) & """ not found");
                  raise Program_Error;
               end if;
            end if;

            --  Get the case variable

            The_Variable := Shared.Variable_Elements. Table (Var_Id).Value;

            if The_Variable.Kind /= Single then

               --  Should never happen, because this has already been checked
               --  during parsing.

               Write_Line ("variable""" & Get_Name_String (Name) &
                           """ is not a single string variable");
               raise Program_Error;
            end if;

            --  Get the case variable value

            Case_Value := The_Variable.Value;
         end;

         --  Now look into all the case items of the case construction

         Case_Item := First_Case_Item_Of (Current_Item, Node_Tree);

         Case_Item_Loop :
         while Present (Case_Item) loop
            Choice_String := First_Choice_Of (Case_Item, Node_Tree);

            --  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, Node_Tree);
               exit Case_Item_Loop;
            end if;

            --  Look into all the alternative of this case item

            Choice_Loop :
            while Present (Choice_String) loop
               if Case_Value = String_Value_Of (Choice_String, Node_Tree) then
                  Decl_Item :=
                    First_Declarative_Item_Of (Case_Item, Node_Tree);
                  exit Case_Item_Loop;
               end if;

               Choice_String := Next_Literal_String (Choice_String, Node_Tree);
            end loop Choice_Loop;

            Case_Item := Next_Case_Item (Case_Item, Node_Tree);
         end loop Case_Item_Loop;

         --  If there is an alternative, then we process it

         if Present (Decl_Item) then
            Process_Declarative_Items
              (Project                => Project,
               In_Tree                => In_Tree,
               From_Project_Node      => From_Project_Node,
               Node_Tree              => Node_Tree,
               Env                    => Env,
               Pkg                    => Pkg,
               Item                   => Decl_Item,
               Child_Env              => Child_Env);
         end if;
      end Process_Case_Construction;

      --  Local variables

      Current, Decl : Project_Node_Id;
      Kind          : Project_Node_Kind;

   --  Start of processing for Process_Declarative_Items

   begin
      Decl := Item;
      while Present (Decl) loop
         Current := Current_Item_Node (Decl, Node_Tree);
         Decl    := Next_Declarative_Item (Decl, Node_Tree);
         Kind    := Kind_Of (Current, Node_Tree);

         case Kind is
            when N_Package_Declaration =>
               Process_Package_Declaration (Current);

            --  Nothing to process for string type declaration

            when N_String_Type_Declaration =>
               null;

            when N_Attribute_Declaration      |
                 N_Typed_Variable_Declaration |
                 N_Variable_Declaration       =>
               Process_Attribute_Declaration (Current);

            when N_Case_Construction =>
               Process_Case_Construction (Current);

            when others =>
               Write_Line ("Illegal declarative item: " & Kind'Img);
               raise Program_Error;
         end case;
      end loop;
   end Process_Declarative_Items;

   ----------------------------------
   -- Process_Project_Tree_Phase_1 --
   ----------------------------------

   procedure Process_Project_Tree_Phase_1
     (In_Tree                : Project_Tree_Ref;
      Project                : out Project_Id;
      Packages_To_Check      : String_List_Access;
      Success                : out Boolean;
      From_Project_Node      : Project_Node_Id;
      From_Project_Node_Tree : Project_Node_Tree_Ref;
      Env                    : in out GPR.Tree.Environment;
      Reset_Tree             : Boolean              := True;
      On_New_Tree_Loaded     : Tree_Loaded_Callback := null)
   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;

      --  And process the main project and all of the projects it depends on,
      --  recursively.

      Debug_Increase_Indent ("Process tree, phase 1");

      Recursive_Process
        (Project                => Project,
         In_Tree                => In_Tree,
         Packages_To_Check      => Packages_To_Check,
         From_Project_Node      => From_Project_Node,
         From_Project_Node_Tree => From_Project_Node_Tree,
         Env                    => Env,
         Extended_By            => No_Project,
         From_Encapsulated_Lib  => False,
         On_New_Tree_Loaded     => On_New_Tree_Loaded);

      Success :=
        Total_Errors_Detected = 0
          and then
          (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);

      if Current_Verbosity = High then
         Debug_Decrease_Indent
           ("Done Process tree, phase 1, Success=" & Success'Img);
      end if;
   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;
      Env                    : Environment)
   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
      Success := True;

      Debug_Increase_Indent ("Process tree, phase 2", Project.Name);

      if Project /= No_Project then
         Check (In_Tree, Project, From_Project_Node_Tree, Env.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 Is_Extending_All (From_Project_Node, From_Project_Node_Tree)
      then
         declare
            Object_Dir : constant Path_Information := Project.Object_Directory;

         begin
            Prj := In_Tree.Projects;
            while Prj /= null loop
               if Prj.Project.Virtual then
                  Prj.Project.Object_Directory := Object_Dir;
               end if;

               Prj := Prj.Next;
            end loop;
         end;
      end if;

      --  Check that no extending project shares its object directory with
      --  the project(s) it extends.

      if Project /= No_Project then
         Prj := In_Tree.Projects;
         while Prj /= null loop
            Extending := Prj.Project.Extended_By;

            if Extending /= No_Project then
               Obj_Dir := Prj.Project.Object_Directory.Name;

               --  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.

               --  Start with the project directly extending it

               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
                          (Env.Flags,
                           "project %% cannot be extended by a virtual" &
                           " project with the same object directory",
                           Prj.Project.Location, Project);

                     else
                        Error_Msg_Name_1 := Extending2.Display_Name;
                        Error_Msg_Name_2 := Prj.Project.Display_Name;
                        Error_Msg
                          (Env.Flags,
                           "project %% cannot extend project %%",
                           Extending2.Location, Project);
                        Error_Msg
                          (Env.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 := Prj.Next;
         end loop;
      end if;

      Debug_Decrease_Indent ("Done Process tree, phase 2");

      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
     (In_Tree                : Project_Tree_Ref;
      Project                : out Project_Id;
      Packages_To_Check      : String_List_Access;
      From_Project_Node      : Project_Node_Id;
      From_Project_Node_Tree : Project_Node_Tree_Ref;
      Env                    : in out GPR.Tree.Environment;
      Extended_By            : Project_Id;
      From_Encapsulated_Lib  : Boolean;
      On_New_Tree_Loaded     : Tree_Loaded_Callback := null)
   is
      Shared : constant Shared_Project_Tree_Data_Access := In_Tree.Shared;

      Child_Env              : GPR.Tree.Environment;
      --  Only used for the root aggregate project (if any). This is left
      --  uninitialized otherwise.

      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.

      procedure Process_Aggregated_Projects;
      --  Process all the projects aggregated in List. This does nothing if the
      --  project is not an aggregate project.

      procedure Process_Extended_Project;
      --  Process the extended 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.

      -------------------------------
      -- 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,
                  Packages_To_Check      => Packages_To_Check,
                  From_Project_Node      =>
                    Project_Node_Of (With_Clause, From_Project_Node_Tree),
                  From_Project_Node_Tree => From_Project_Node_Tree,
                  Env                    => Env,
                  Extended_By            => No_Project,
                  From_Encapsulated_Lib  => From_Encapsulated_Lib,
                  On_New_Tree_Loaded     => On_New_Tree_Loaded);

               if Imported = null then
                  Project.Imported_Projects := new Project_List_Element'
                    (Project               => New_Project,
                     From_Encapsulated_Lib => False,
                     Next                  => null);
                  Imported := Project.Imported_Projects;
               else
                  Imported.Next := new Project_List_Element'
                    (Project               => New_Project,
                     From_Encapsulated_Lib => False,
                     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;

      ---------------------------------
      -- Process_Aggregated_Projects --
      ---------------------------------

      procedure Process_Aggregated_Projects is
         List           : Aggregated_Project_List;
         Loaded_Project : GPR.Project_Node_Id;
         Success        : Boolean := True;
         Tree           : Project_Tree_Ref;
         Node_Tree      : Project_Node_Tree_Ref;

      begin
         if Project.Qualifier not in Aggregate_Project then
            return;
         end if;

         Debug_Increase_Indent ("Process_Aggregated_Projects", Project.Name);

         GPR.Nmsc.Process_Aggregated_Projects
           (Tree      => In_Tree,
            Project   => Project,
            Node_Tree => From_Project_Node_Tree,
            Flags     => Env.Flags);

         List := Project.Aggregated_Projects;
         while Success and then List /= null loop
            Node_Tree := new Project_Node_Tree_Data;
            Initialize (Node_Tree);

            GPR.Part.Parse
              (In_Tree           => Node_Tree,
               Project           => Loaded_Project,
               Packages_To_Check => Packages_To_Check,
               Project_File_Name => Get_Name_String (List.Path),
               Errout_Handling   => GPR.Part.Never_Finalize,
               Current_Directory => Get_Name_String (Project.Directory.Name),
               Is_Config_File    => False,
               Env               => Child_Env);

            Success := not GPR.Tree.No (Loaded_Project);

            if Success then
               if Node_Tree.Incomplete_With then
                  From_Project_Node_Tree.Incomplete_With := True;
               end if;

               List.Tree := new Project_Tree_Data (Is_Root_Tree => False);
               GPR.Initialize (List.Tree);
               List.Tree.Shared := In_Tree.Shared;
               List.Node_Tree := Node_Tree;

               --  In aggregate library, aggregated projects are parsed using
               --  the aggregate library tree.

               if Project.Qualifier = Aggregate_Library then
                  Tree := In_Tree;
               else
                  Tree := List.Tree;
               end if;

               --  We can only do the phase 1 of the processing, since we do
               --  not have access to the configuration file yet (this is
               --  called when doing phase 1 of the processing for the root
               --  aggregate project).

               if In_Tree.Is_Root_Tree then
                  Process_Project_Tree_Phase_1
                    (In_Tree                => Tree,
                     Project                => List.Project,
                     Packages_To_Check      => Packages_To_Check,
                     Success                => Success,
                     From_Project_Node      => Loaded_Project,
                     From_Project_Node_Tree => Node_Tree,
                     Env                    => Child_Env,
                     Reset_Tree             => False,
                     On_New_Tree_Loaded     => On_New_Tree_Loaded);
               else
                  --  use the same environment as the rest of the aggregated
                  --  projects, ie the one that was setup by the root aggregate
                  Process_Project_Tree_Phase_1
                    (In_Tree                => Tree,
                     Project                => List.Project,
                     Packages_To_Check      => Packages_To_Check,
                     Success                => Success,
                     From_Project_Node      => Loaded_Project,
                     From_Project_Node_Tree => Node_Tree,
                     Env                    => Env,
                     Reset_Tree             => False,
                     On_New_Tree_Loaded     => On_New_Tree_Loaded);
               end if;

               if On_New_Tree_Loaded /= null then
                  On_New_Tree_Loaded
                    (Node_Tree, Tree, Loaded_Project, List.Project);
               end if;

            else
               Debug_Output ("Failed to parse", Name_Id (List.Path));
            end if;

            List := List.Next;
         end loop;

         Debug_Decrease_Indent ("Done Process_Aggregated_Projects");
      end Process_Aggregated_Projects;

      ------------------------------
      -- Process_Extended_Project --
      ------------------------------

      procedure Process_Extended_Project is
         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 := Shared.Packages.Table (Extended_Pkg);

            Current_Pkg := First;
            while Current_Pkg /= No_Package
              and then
                Shared.Packages.Table (Current_Pkg).Name /= Element.Name
            loop
               Current_Pkg := Shared.Packages.Table (Current_Pkg).Next;
            end loop;

            if Current_Pkg = No_Package then
               Package_Table.Increment_Last (Shared.Packages);
               Current_Pkg := Package_Table.Last (Shared.Packages);
               Shared.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         => Shared.Packages.Table (Current_Pkg).Decl,
                  New_Loc    => No_Location,
                  Restricted => True,
                  Shared     => Shared);
            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 := Shared.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 := Shared.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
                    (Shared.Variable_Elements);
                  Attribute1 := Variable_Element_Table.Last
                    (Shared.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;
               Shared.Variable_Elements.Table (Attribute1) := Attr_Value1;
            end if;
         end if;
      end Process_Extended_Project;

   --  Start of processing for Recursive_Process

   begin
      if No (From_Project_Node) then
         Project := No_Project;

      else
         declare
            Imported, Mark   : Project_List;
            Declaration_Node : Project_Node_Id  := Empty_Project_Node;

            Name : constant Name_Id :=
                     Name_Of (From_Project_Node, From_Project_Node_Tree);

            Display_Name : constant Name_Id :=
                             Display_Name_Of
                               (From_Project_Node, From_Project_Node_Tree);

         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;

            --  Check if the project is already in the tree

            Project := No_Project;

            declare
               List : Project_List := In_Tree.Projects;
               Path : constant Path_Name_Type :=
                        Path_Name_Of (From_Project_Node,
                                      From_Project_Node_Tree);
               Path_Name : String := Get_Name_String (Path);

            begin
               Canonical_Case_File_Name (Path_Name);

               while List /= null loop
                  if List.Project.Path.Display_Name /= No_Path then
                     declare
                        Project_Path : String :=
                          Get_Name_String (List.Project.Path.Display_Name);
                     begin
                        Canonical_Case_File_Name (Project_Path);

                        if Project_Path = Path_Name then
                           Project := List.Project;
                           exit;
                        end if;
                     end;
                  end if;

                  List := List.Next;
               end loop;
            end;

            if Project = No_Project then
               Project :=
                 new Project_Data'
                   (Empty_Project
                      (Project_Qualifier_Of
                         (From_Project_Node, From_Project_Node_Tree)));

               --  Note that at this point we do not know yet if the project
               --  has been withed from an encapsulated library or not.

               In_Tree.Projects :=
                 new Project_List_Element'
                   (Project               => Project,
                    From_Encapsulated_Lib => False,
                    Next                  => In_Tree.Projects);
            end if;

            --  Keep track of this point

            Mark := In_Tree.Projects;

            Processed_Projects.Set (Name, Project);

            Project.Name := Name;
            Project.Display_Name := Display_Name;

            Get_Name_String (Name);

            --  If name starts with the virtual prefix, flag the project as
            --  being a virtual extending project.

            if Name_Len > Virtual_Prefix'Length
              and then
                Name_Buffer (1 .. Virtual_Prefix'Length) = Virtual_Prefix
            then
               Project.Virtual := True;
            end if;

            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;

            Project.Location :=
              Location_Of (From_Project_Node, From_Project_Node_Tree);

            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;

            Project.Extended_By := Extended_By;

            Add_Attributes
              (Project,
               Name,
               Name_Id (Project.Directory.Display_Name),
               In_Tree.Shared,
               Project.Decl,
               GPR.Attr.Attribute_First,
               Project_Level => True);

            Process_Imported_Projects (Imported, Limited_With => False);

            if Project.Qualifier = Aggregate then
               Initialize_And_Copy (Child_Env, Copy_From => Env);

            elsif Project.Qualifier = Aggregate_Library then

               --  The child environment is the same as the current one.
               --  Copy the Project_Path, so that if it is freed, the project
               --  path of the parent is not modified.

               Child_Env := (Env.External, No_Project_Search_Path, Env.Flags);
               Copy (Env.Project_Path, Child_Env.Project_Path);

            else
               --  No need to initialize Child_Env, since it will not be
               --  used anyway by Process_Declarative_Items (only the root
               --  aggregate can modify it, and it is never read anyway).

               null;
            end if;

            Declaration_Node :=
              Project_Declaration_Of
                (From_Project_Node, From_Project_Node_Tree);

            Recursive_Process
              (In_Tree                => In_Tree,
               Project                => Project.Extends,
               Packages_To_Check      => Packages_To_Check,
               From_Project_Node      =>
                 Extended_Project_Of
                   (Declaration_Node, From_Project_Node_Tree),
               From_Project_Node_Tree => From_Project_Node_Tree,
               Env                    => Env,
               Extended_By            => Project,
               From_Encapsulated_Lib  => From_Encapsulated_Lib,
               On_New_Tree_Loaded     => On_New_Tree_Loaded);

            Process_Declarative_Items
              (Project                => Project,
               In_Tree                => In_Tree,
               From_Project_Node      => From_Project_Node,
               Node_Tree              => From_Project_Node_Tree,
               Env                    => Env,
               Pkg                    => No_Package,
               Item                   => First_Declarative_Item_Of
                 (Declaration_Node, From_Project_Node_Tree),
               Child_Env              => Child_Env);

            if Project.Extends /= No_Project then
               Process_Extended_Project;
            end if;

            Process_Imported_Projects (Imported, Limited_With => True);

            if Total_Errors_Detected = 0 then
               Process_Aggregated_Projects;
            end if;

            --  At this point (after Process_Declarative_Items) we have the
            --  attribute values set, we can backtrace In_Tree.Project and
            --  set the From_Encapsulated_Library status.

            declare
               Lib_Standalone  : constant GPR.Variable_Value :=
                                   GPR.Util.Value_Of
                                     (Snames.Name_Library_Standalone,
                                      Project.Decl.Attributes,
                                      Shared);
               List            : Project_List := In_Tree.Projects;
               Is_Encapsulated : Boolean;

            begin
               Get_Name_String (Lib_Standalone.Value);
               To_Lower (Name_Buffer (1 .. Name_Len));

               Is_Encapsulated := Name_Buffer (1 .. Name_Len) = "encapsulated";

               if Is_Encapsulated then
                  while List /= null and then List /= Mark loop
                     List.From_Encapsulated_Lib := Is_Encapsulated;
                     List := List.Next;
                  end loop;
               end if;

               if Total_Errors_Detected = 0 then

                  --  For an aggregate library we add the aggregated projects
                  --  as imported ones. This is necessary to give visibility
                  --  to all sources from the aggregates from the aggregated
                  --  library projects.

                  if Project.Qualifier = Aggregate_Library then
                     declare
                        L : Aggregated_Project_List;
                     begin
                        L := Project.Aggregated_Projects;
                        while L /= null loop
                           Project.Imported_Projects :=
                             new Project_List_Element'
                               (Project               => L.Project,
                                From_Encapsulated_Lib => Is_Encapsulated,
                                Next                  =>
                                  Project.Imported_Projects);
                           L := L.Next;
                        end loop;
                     end;
                  end if;
               end if;
            end;

            if Project.Qualifier = Aggregate and then In_Tree.Is_Root_Tree then
               Free (Child_Env);
            end if;
         end;
      end if;
   end Recursive_Process;

   -----------------------------
   -- Set_Default_Runtime_For --
   -----------------------------

   procedure Set_Default_Runtime_For (Language : Name_Id; Value : String) is
   begin
      Name_Len := Value'Length;
      Name_Buffer (1 .. Name_Len) := Value;
      Runtime_Defaults.Set (Language, Name_Find);
   end Set_Default_Runtime_For;
end GPR.Proc;
