gcc/ada/prj-proc.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              P R J . P R O C                             --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2001-2011, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Err_Vars; use Err_Vars;
  27 with Opt;      use Opt;
  28 with Osint;    use Osint;
  29 with Output;   use Output;
  30 with Prj.Attr; use Prj.Attr;
  31 with Prj.Env;
  32 with Prj.Err;  use Prj.Err;
  33 with Prj.Ext;  use Prj.Ext;
  34 with Prj.Nmsc; use Prj.Nmsc;
  35 with Prj.Part;
  36 with Snames;
  37
  38 with Ada.Strings.Fixed; use Ada.Strings.Fixed;
  39
  40 with GNAT.Case_Util; use GNAT.Case_Util;
  41 with GNAT.HTable;
  42
  43 package body Prj.Proc is
  44
  45    package Processed_Projects is new GNAT.HTable.Simple_HTable
  46      (Header_Num => Header_Num,
  47       Element    => Project_Id,
  48       No_Element => No_Project,
  49       Key        => Name_Id,
  50       Hash       => Hash,
  51       Equal      => "=");
  52    --  This hash table contains all processed projects
  53
  54    package Unit_Htable is new GNAT.HTable.Simple_HTable
  55      (Header_Num => Header_Num,
  56       Element    => Source_Id,
  57       No_Element => No_Source,
  58       Key        => Name_Id,
  59       Hash       => Hash,
  60       Equal      => "=");
  61    --  This hash table contains all processed projects
  62
  63    procedure Add (To_Exp : in out Name_Id; Str : Name_Id);
  64    --  Concatenate two strings and returns another string if both
  65    --  arguments are not null string.
  66
  67    --  In the following procedures, we are expected to guess the meaning of
  68    --  the parameters from their names, this is never a good idea, comments
  69    --  should be added precisely defining every formal ???
  70
  71    procedure Add_Attributes
  72      (Project       : Project_Id;
  73       Project_Name  : Name_Id;
  74       Project_Dir   : Name_Id;
  75       Shared        : Shared_Project_Tree_Data_Access;
  76       Decl          : in out Declarations;
  77       First         : Attribute_Node_Id;
  78       Project_Level : Boolean);
  79    --  Add all attributes, starting with First, with their default values to
  80    --  the package or project with declarations Decl.
  81
  82    procedure Check
  83      (In_Tree   : Project_Tree_Ref;
  84       Project   : Project_Id;
  85       Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
  86       Flags     : Processing_Flags);
  87    --  Set all projects to not checked, then call Recursive_Check for the
  88    --  main project Project. Project is set to No_Project if errors occurred.
  89    --  Current_Dir is for optimization purposes, avoiding extra system calls.
  90    --  If Allow_Duplicate_Basenames, then files with the same base names are
  91    --  authorized within a project for source-based languages (never for unit
  92    --  based languages)
  93
  94    procedure Copy_Package_Declarations
  95      (From       : Declarations;
  96       To         : in out Declarations;
  97       New_Loc    : Source_Ptr;
  98       Restricted : Boolean;
  99       Shared     : Shared_Project_Tree_Data_Access);
 100    --  Copy a package declaration From to To for a renamed package. Change the
 101    --  locations of all the attributes to New_Loc. When Restricted is
 102    --  True, do not copy attributes Body, Spec, Implementation, Specification
 103    --  and Linker_Options.
 104
 105    function Expression
 106      (Project                : Project_Id;
 107       Shared                 : Shared_Project_Tree_Data_Access;
 108       From_Project_Node      : Project_Node_Id;
 109       From_Project_Node_Tree : Project_Node_Tree_Ref;
 110       Env                    : Prj.Tree.Environment;
 111       Pkg                    : Package_Id;
 112       First_Term             : Project_Node_Id;
 113       Kind                   : Variable_Kind) return Variable_Value;
 114    --  From N_Expression project node From_Project_Node, compute the value
 115    --  of an expression and return it as a Variable_Value.
 116
 117    function Imported_Or_Extended_Project_From
 118      (Project   : Project_Id;
 119       With_Name : Name_Id) return Project_Id;
 120    --  Find an imported or extended project of Project whose name is With_Name
 121
 122    function Package_From
 123      (Project   : Project_Id;
 124       Shared    : Shared_Project_Tree_Data_Access;
 125       With_Name : Name_Id) return Package_Id;
 126    --  Find the package of Project whose name is With_Name
 127
 128    procedure Process_Declarative_Items
 129      (Project           : Project_Id;
 130       In_Tree           : Project_Tree_Ref;
 131       From_Project_Node : Project_Node_Id;
 132       Node_Tree         : Project_Node_Tree_Ref;
 133       Env               : Prj.Tree.Environment;
 134       Pkg               : Package_Id;
 135       Item              : Project_Node_Id;
 136       Child_Env         : in out Prj.Tree.Environment);
 137    --  Process declarative items starting with From_Project_Node, and put them
 138    --  in declarations Decl. This is a recursive procedure; it calls itself for
 139    --  a package declaration or a case construction.
 140    --
 141    --  Child_Env is the modified environment after seeing declarations like
 142    --  "for External(...) use" or "for Project_Path use" in aggregate projects.
 143    --  It should have been initialized first.
 144
 145    procedure Recursive_Process
 146      (In_Tree                : Project_Tree_Ref;
 147       Project                : out Project_Id;
 148       Packages_To_Check      : String_List_Access;
 149       From_Project_Node      : Project_Node_Id;
 150       From_Project_Node_Tree : Project_Node_Tree_Ref;
 151       Env                    : in out Prj.Tree.Environment;
 152       Extended_By            : Project_Id);
 153    --  Process project with node From_Project_Node in the tree. Do nothing if
 154    --  From_Project_Node is Empty_Node. If project has already been processed,
 155    --  simply return its project id. Otherwise create a new project id, mark it
 156    --  as processed, call itself recursively for all imported projects and a
 157    --  extended project, if any. Then process the declarative items of the
 158    --  project.
 159    --
 160    --  Is_Root_Project should be true only for the project that the user
 161    --  explicitly loaded. In the context of aggregate projects, only that
 162    --  project is allowed to modify the environment that will be used to load
 163    --  projects (Child_Env).
 164
 165    function Get_Attribute_Index
 166      (Tree  : Project_Node_Tree_Ref;
 167       Attr  : Project_Node_Id;
 168       Index : Name_Id) return Name_Id;
 169    --  Copy the index of the attribute into Name_Buffer, converting to lower
 170    --  case if the attribute is case-insensitive.
 171
 172    ---------
 173    -- Add --
 174    ---------
 175
 176    procedure Add (To_Exp : in out Name_Id; Str : Name_Id) is
 177    begin
 178       if To_Exp = No_Name or else To_Exp = Empty_String then
 179
 180          --  To_Exp is nil or empty. The result is Str
 181
 182          To_Exp := Str;
 183
 184       --  If Str is nil, then do not change To_Ext
 185
 186       elsif Str /= No_Name and then Str /= Empty_String then
 187          declare
 188             S : constant String := Get_Name_String (Str);
 189          begin
 190             Get_Name_String (To_Exp);
 191             Add_Str_To_Name_Buffer (S);
 192             To_Exp := Name_Find;
 193          end;
 194       end if;
 195    end Add;
 196
 197    --------------------
 198    -- Add_Attributes --
 199    --------------------
 200
 201    procedure Add_Attributes
 202      (Project       : Project_Id;
 203       Project_Name  : Name_Id;
 204       Project_Dir   : Name_Id;
 205       Shared        : Shared_Project_Tree_Data_Access;
 206       Decl          : in out Declarations;
 207       First         : Attribute_Node_Id;
 208       Project_Level : Boolean)
 209    is
 210       The_Attribute  : Attribute_Node_Id := First;
 211
 212    begin
 213       while The_Attribute /= Empty_Attribute loop
 214          if Attribute_Kind_Of (The_Attribute) = Single then
 215             declare
 216                New_Attribute : Variable_Value;
 217
 218             begin
 219                case Variable_Kind_Of (The_Attribute) is
 220
 221                   --  Undefined should not happen
 222
 223                   when Undefined =>
 224                      pragma Assert
 225                        (False, "attribute with an undefined kind");
 226                      raise Program_Error;
 227
 228                   --  Single attributes have a default value of empty string
 229
 230                   when Single =>
 231                      New_Attribute :=
 232                        (Project  => Project,
 233                         Kind     => Single,
 234                         Location => No_Location,
 235                         Default  => True,
 236                         Value    => Empty_String,
 237                         Index    => 0);
 238
 239                      --  Special cases of <project>'Name and
 240                      --  <project>'Project_Dir.
 241
 242                      if Project_Level then
 243                         if Attribute_Name_Of (The_Attribute) =
 244                           Snames.Name_Name
 245                         then
 246                            New_Attribute.Value := Project_Name;
 247
 248                         elsif Attribute_Name_Of (The_Attribute) =
 249                           Snames.Name_Project_Dir
 250                         then
 251                            New_Attribute.Value := Project_Dir;
 252                         end if;
 253                      end if;
 254
 255                   --  List attributes have a default value of nil list
 256
 257                   when List =>
 258                      New_Attribute :=
 259                        (Project  => Project,
 260                         Kind     => List,
 261                         Location => No_Location,
 262                         Default  => True,
 263                         Values   => Nil_String);
 264
 265                end case;
 266
 267                Variable_Element_Table.Increment_Last
 268                  (Shared.Variable_Elements);
 269                Shared.Variable_Elements.Table
 270                  (Variable_Element_Table.Last (Shared.Variable_Elements)) :=
 271                  (Next  => Decl.Attributes,
 272                   Name  => Attribute_Name_Of (The_Attribute),
 273                   Value => New_Attribute);
 274                Decl.Attributes :=
 275                  Variable_Element_Table.Last
 276                    (Shared.Variable_Elements);
 277             end;
 278          end if;
 279
 280          The_Attribute := Next_Attribute (After => The_Attribute);
 281       end loop;
 282    end Add_Attributes;
 283
 284    -----------
 285    -- Check --
 286    -----------
 287
 288    procedure Check
 289      (In_Tree   : Project_Tree_Ref;
 290       Project   : Project_Id;
 291       Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
 292       Flags     : Processing_Flags)
 293    is
 294    begin
 295       Process_Naming_Scheme (In_Tree, Project, Node_Tree, Flags);
 296
 297       --  Set the Other_Part field for the units
 298
 299       declare
 300          Source1 : Source_Id;
 301          Name    : Name_Id;
 302          Source2 : Source_Id;
 303          Iter    : Source_Iterator;
 304
 305       begin
 306          Unit_Htable.Reset;
 307
 308          Iter := For_Each_Source (In_Tree);
 309          loop
 310             Source1 := Prj.Element (Iter);
 311             exit when Source1 = No_Source;
 312
 313             if Source1.Unit /= No_Unit_Index then
 314                Name := Source1.Unit.Name;
 315                Source2 := Unit_Htable.Get (Name);
 316
 317                if Source2 = No_Source then
 318                   Unit_Htable.Set (K => Name, E => Source1);
 319                else
 320                   Unit_Htable.Remove (Name);
 321                end if;
 322             end if;
 323
 324             Next (Iter);
 325          end loop;
 326       end;
 327    end Check;
 328
 329    -------------------------------
 330    -- Copy_Package_Declarations --
 331    -------------------------------
 332
 333    procedure Copy_Package_Declarations
 334      (From       : Declarations;
 335       To         : in out Declarations;
 336       New_Loc    : Source_Ptr;
 337       Restricted : Boolean;
 338       Shared     : Shared_Project_Tree_Data_Access)
 339    is
 340       V1  : Variable_Id;
 341       V2  : Variable_Id      := No_Variable;
 342       Var : Variable;
 343       A1  : Array_Id;
 344       A2  : Array_Id         := No_Array;
 345       Arr : Array_Data;
 346       E1  : Array_Element_Id;
 347       E2  : Array_Element_Id := No_Array_Element;
 348       Elm : Array_Element;
 349
 350    begin
 351       --  To avoid references in error messages to attribute declarations in
 352       --  an original package that has been renamed, copy all the attribute
 353       --  declarations of the package and change all locations to New_Loc,
 354       --  the location of the renamed package.
 355
 356       --  First single attributes
 357
 358       V1 := From.Attributes;
 359       while V1 /= No_Variable loop
 360
 361          --  Copy the attribute
 362
 363          Var := Shared.Variable_Elements.Table (V1);
 364          V1  := Var.Next;
 365
 366          --  Do not copy the value of attribute Linker_Options if Restricted
 367
 368          if Restricted and then Var.Name = Snames.Name_Linker_Options then
 369             Var.Value.Values := Nil_String;
 370          end if;
 371
 372          --  Remove the Next component
 373
 374          Var.Next := No_Variable;
 375
 376          --  Change the location to New_Loc
 377
 378          Var.Value.Location := New_Loc;
 379          Variable_Element_Table.Increment_Last (Shared.Variable_Elements);
 380
 381          --  Put in new declaration
 382
 383          if To.Attributes = No_Variable then
 384             To.Attributes :=
 385               Variable_Element_Table.Last (Shared.Variable_Elements);
 386          else
 387             Shared.Variable_Elements.Table (V2).Next :=
 388               Variable_Element_Table.Last (Shared.Variable_Elements);
 389          end if;
 390
 391          V2 := Variable_Element_Table.Last (Shared.Variable_Elements);
 392          Shared.Variable_Elements.Table (V2) := Var;
 393       end loop;
 394
 395       --  Then the associated array attributes
 396
 397       A1 := From.Arrays;
 398       while A1 /= No_Array loop
 399          Arr := Shared.Arrays.Table (A1);
 400          A1  := Arr.Next;
 401
 402          --  Remove the Next component
 403
 404          Arr.Next := No_Array;
 405          Array_Table.Increment_Last (Shared.Arrays);
 406
 407          --  Create new Array declaration
 408
 409          if To.Arrays = No_Array then
 410             To.Arrays := Array_Table.Last (Shared.Arrays);
 411          else
 412             Shared.Arrays.Table (A2).Next :=
 413               Array_Table.Last (Shared.Arrays);
 414          end if;
 415
 416          A2 := Array_Table.Last (Shared.Arrays);
 417
 418          --  Don't store the array as its first element has not been set yet
 419
 420          --  Copy the array elements of the array
 421
 422          E1 := Arr.Value;
 423          Arr.Value := No_Array_Element;
 424          while E1 /= No_Array_Element loop
 425
 426             --  Copy the array element
 427
 428             Elm := Shared.Array_Elements.Table (E1);
 429             E1 := Elm.Next;
 430
 431             --  Remove the Next component
 432
 433             Elm.Next := No_Array_Element;
 434
 435             Elm.Restricted := Restricted;
 436
 437             --  Change the location
 438
 439             Elm.Value.Location := New_Loc;
 440             Array_Element_Table.Increment_Last (Shared.Array_Elements);
 441
 442             --  Create new array element
 443
 444             if Arr.Value = No_Array_Element then
 445                Arr.Value := Array_Element_Table.Last (Shared.Array_Elements);
 446             else
 447                Shared.Array_Elements.Table (E2).Next :=
 448                  Array_Element_Table.Last (Shared.Array_Elements);
 449             end if;
 450
 451             E2 := Array_Element_Table.Last (Shared.Array_Elements);
 452             Shared.Array_Elements.Table (E2) := Elm;
 453          end loop;
 454
 455          --  Finally, store the new array
 456
 457          Shared.Arrays.Table (A2) := Arr;
 458       end loop;
 459    end Copy_Package_Declarations;
 460
 461    -------------------------
 462    -- Get_Attribute_Index --
 463    -------------------------
 464
 465    function Get_Attribute_Index
 466      (Tree  : Project_Node_Tree_Ref;
 467       Attr  : Project_Node_Id;
 468       Index : Name_Id) return Name_Id
 469    is
 470    begin
 471       if Index = All_Other_Names
 472         or else not Case_Insensitive (Attr, Tree)
 473       then
 474          return Index;
 475       end if;
 476
 477       Get_Name_String (Index);
 478       To_Lower (Name_Buffer (1 .. Name_Len));
 479       return Name_Find;
 480    end Get_Attribute_Index;
 481
 482    ----------------
 483    -- Expression --
 484    ----------------
 485
 486    function Expression
 487      (Project                : Project_Id;
 488       Shared                 : Shared_Project_Tree_Data_Access;
 489       From_Project_Node      : Project_Node_Id;
 490       From_Project_Node_Tree : Project_Node_Tree_Ref;
 491       Env                    : Prj.Tree.Environment;
 492       Pkg                    : Package_Id;
 493       First_Term             : Project_Node_Id;
 494       Kind                   : Variable_Kind) return Variable_Value
 495    is
 496       The_Term : Project_Node_Id;
 497       --  The term in the expression list
 498
 499       The_Current_Term : Project_Node_Id := Empty_Node;
 500       --  The current term node id
 501
 502       Result : Variable_Value (Kind => Kind);
 503       --  The returned result
 504
 505       Last : String_List_Id := Nil_String;
 506       --  Reference to the last string elements in Result, when Kind is List
 507
 508    begin
 509       Result.Project := Project;
 510       Result.Location := Location_Of (First_Term, From_Project_Node_Tree);
 511
 512       --  Process each term of the expression, starting with First_Term
 513
 514       The_Term := First_Term;
 515       while Present (The_Term) loop
 516          The_Current_Term := Current_Term (The_Term, From_Project_Node_Tree);
 517
 518          case Kind_Of (The_Current_Term, From_Project_Node_Tree) is
 519
 520             when N_Literal_String =>
 521
 522                case Kind is
 523
 524                   when Undefined =>
 525
 526                      --  Should never happen
 527
 528                      pragma Assert (False, "Undefined expression kind");
 529                      raise Program_Error;
 530
 531                   when Single =>
 532                      Add (Result.Value,
 533                           String_Value_Of
 534                             (The_Current_Term, From_Project_Node_Tree));
 535                      Result.Index :=
 536                        Source_Index_Of
 537                          (The_Current_Term, From_Project_Node_Tree);
 538
 539                   when List =>
 540
 541                      String_Element_Table.Increment_Last
 542                        (Shared.String_Elements);
 543
 544                      if Last = Nil_String then
 545
 546                         --  This can happen in an expression like () & "toto"
 547
 548                         Result.Values := String_Element_Table.Last
 549                           (Shared.String_Elements);
 550
 551                      else
 552                         Shared.String_Elements.Table
 553                           (Last).Next := String_Element_Table.Last
 554                                        (Shared.String_Elements);
 555                      end if;
 556
 557                      Last := String_Element_Table.Last
 558                                (Shared.String_Elements);
 559
 560                      Shared.String_Elements.Table (Last) :=
 561                        (Value         => String_Value_Of
 562                                            (The_Current_Term,
 563                                             From_Project_Node_Tree),
 564                         Index         => Source_Index_Of
 565                                            (The_Current_Term,
 566                                             From_Project_Node_Tree),
 567                         Display_Value => No_Name,
 568                         Location      => Location_Of
 569                                            (The_Current_Term,
 570                                             From_Project_Node_Tree),
 571                         Flag          => False,
 572                         Next          => Nil_String);
 573                end case;
 574
 575             when N_Literal_String_List =>
 576
 577                declare
 578                   String_Node : Project_Node_Id :=
 579                                   First_Expression_In_List
 580                                     (The_Current_Term,
 581                                      From_Project_Node_Tree);
 582
 583                   Value : Variable_Value;
 584
 585                begin
 586                   if Present (String_Node) then
 587
 588                      --  If String_Node is nil, it is an empty list, there is
 589                      --  nothing to do.
 590
 591                      Value := Expression
 592                        (Project                => Project,
 593                         Shared                 => Shared,
 594                         From_Project_Node      => From_Project_Node,
 595                         From_Project_Node_Tree => From_Project_Node_Tree,
 596                         Env                    => Env,
 597                         Pkg                    => Pkg,
 598                         First_Term             =>
 599                           Tree.First_Term
 600                             (String_Node, From_Project_Node_Tree),
 601                         Kind                   => Single);
 602                      String_Element_Table.Increment_Last
 603                        (Shared.String_Elements);
 604
 605                      if Result.Values = Nil_String then
 606
 607                         --  This literal string list is the first term in a
 608                         --  string list expression
 609
 610                         Result.Values :=
 611                           String_Element_Table.Last
 612                             (Shared.String_Elements);
 613
 614                      else
 615                         Shared.String_Elements.Table (Last).Next :=
 616                           String_Element_Table.Last (Shared.String_Elements);
 617                      end if;
 618
 619                      Last :=
 620                        String_Element_Table.Last (Shared.String_Elements);
 621
 622                      Shared.String_Elements.Table (Last) :=
 623                        (Value    => Value.Value,
 624                         Display_Value => No_Name,
 625                         Location => Value.Location,
 626                         Flag     => False,
 627                         Next     => Nil_String,
 628                         Index    => Value.Index);
 629
 630                      loop
 631                         --  Add the other element of the literal string list
 632                         --  one after the other.
 633
 634                         String_Node :=
 635                           Next_Expression_In_List
 636                             (String_Node, From_Project_Node_Tree);
 637
 638                         exit when No (String_Node);
 639
 640                         Value :=
 641                           Expression
 642                             (Project                => Project,
 643                              Shared                 => Shared,
 644                              From_Project_Node      => From_Project_Node,
 645                              From_Project_Node_Tree => From_Project_Node_Tree,
 646                              Env                    => Env,
 647                              Pkg                    => Pkg,
 648                              First_Term             =>
 649                                Tree.First_Term
 650                                  (String_Node, From_Project_Node_Tree),
 651                              Kind                   => Single);
 652
 653                         String_Element_Table.Increment_Last
 654                           (Shared.String_Elements);
 655                         Shared.String_Elements.Table (Last).Next :=
 656                           String_Element_Table.Last (Shared.String_Elements);
 657                         Last := String_Element_Table.Last
 658                           (Shared.String_Elements);
 659                         Shared.String_Elements.Table (Last) :=
 660                           (Value    => Value.Value,
 661                            Display_Value => No_Name,
 662                            Location => Value.Location,
 663                            Flag     => False,
 664                            Next     => Nil_String,
 665                            Index    => Value.Index);
 666                      end loop;
 667                   end if;
 668                end;
 669
 670             when N_Variable_Reference | N_Attribute_Reference =>
 671
 672                declare
 673                   The_Project     : Project_Id  := Project;
 674                   The_Package     : Package_Id  := Pkg;
 675                   The_Name        : Name_Id     := No_Name;
 676                   The_Variable_Id : Variable_Id := No_Variable;
 677                   The_Variable    : Variable_Value;
 678                   Term_Project    : constant Project_Node_Id :=
 679                                       Project_Node_Of
 680                                         (The_Current_Term,
 681                                          From_Project_Node_Tree);
 682                   Term_Package    : constant Project_Node_Id :=
 683                                       Package_Node_Of
 684                                         (The_Current_Term,
 685                                          From_Project_Node_Tree);
 686                   Index           : Name_Id := No_Name;
 687
 688                begin
 689                   if Present (Term_Project)
 690                     and then Term_Project /= From_Project_Node
 691                   then
 692                      --  This variable or attribute comes from another project
 693
 694                      The_Name :=
 695                        Name_Of (Term_Project, From_Project_Node_Tree);
 696                      The_Project := Imported_Or_Extended_Project_From
 697                                       (Project   => Project,
 698                                        With_Name => The_Name);
 699                   end if;
 700
 701                   if Present (Term_Package) then
 702
 703                      --  This is an attribute of a package
 704
 705                      The_Name :=
 706                        Name_Of (Term_Package, From_Project_Node_Tree);
 707
 708                      The_Package := The_Project.Decl.Packages;
 709                      while The_Package /= No_Package
 710                        and then Shared.Packages.Table (The_Package).Name /=
 711                           The_Name
 712                      loop
 713                         The_Package :=
 714                           Shared.Packages.Table (The_Package).Next;
 715                      end loop;
 716
 717                      pragma Assert
 718                        (The_Package /= No_Package, "package not found.");
 719
 720                   elsif Kind_Of (The_Current_Term, From_Project_Node_Tree) =
 721                                                         N_Attribute_Reference
 722                   then
 723                      The_Package := No_Package;
 724                   end if;
 725
 726                   The_Name :=
 727                     Name_Of (The_Current_Term, From_Project_Node_Tree);
 728
 729                   if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
 730                                                         N_Attribute_Reference
 731                   then
 732                      Index :=
 733                        Associative_Array_Index_Of
 734                          (The_Current_Term, From_Project_Node_Tree);
 735                   end if;
 736
 737                   --  If it is not an associative array attribute
 738
 739                   if Index = No_Name then
 740
 741                      --  It is not an associative array attribute
 742
 743                      if The_Package /= No_Package then
 744
 745                         --  First, if there is a package, look into the package
 746
 747                         if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
 748                                                         N_Variable_Reference
 749                         then
 750                            The_Variable_Id :=
 751                              Shared.Packages.Table
 752                                (The_Package).Decl.Variables;
 753                         else
 754                            The_Variable_Id :=
 755                              Shared.Packages.Table
 756                                (The_Package).Decl.Attributes;
 757                         end if;
 758
 759                         while The_Variable_Id /= No_Variable
 760                           and then Shared.Variable_Elements.Table
 761                                      (The_Variable_Id).Name /= The_Name
 762                         loop
 763                            The_Variable_Id :=
 764                              Shared.Variable_Elements.Table
 765                                (The_Variable_Id).Next;
 766                         end loop;
 767
 768                      end if;
 769
 770                      if The_Variable_Id = No_Variable then
 771
 772                         --  If we have not found it, look into the project
 773
 774                         if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
 775                              N_Variable_Reference
 776                         then
 777                            The_Variable_Id := The_Project.Decl.Variables;
 778                         else
 779                            The_Variable_Id := The_Project.Decl.Attributes;
 780                         end if;
 781
 782                         while The_Variable_Id /= No_Variable
 783                           and then Shared.Variable_Elements.Table
 784                             (The_Variable_Id).Name /= The_Name
 785                         loop
 786                            The_Variable_Id :=
 787                              Shared.Variable_Elements.Table
 788                                (The_Variable_Id).Next;
 789                         end loop;
 790
 791                      end if;
 792
 793                      pragma Assert (The_Variable_Id /= No_Variable,
 794                                       "variable or attribute not found");
 795
 796                      The_Variable :=
 797                        Shared.Variable_Elements.Table (The_Variable_Id).Value;
 798
 799                   else
 800
 801                      --  It is an associative array attribute
 802
 803                      declare
 804                         The_Array   : Array_Id := No_Array;
 805                         The_Element : Array_Element_Id := No_Array_Element;
 806                         Array_Index : Name_Id := No_Name;
 807
 808                      begin
 809                         if The_Package /= No_Package then
 810                            The_Array :=
 811                              Shared.Packages.Table (The_Package).Decl.Arrays;
 812                         else
 813                            The_Array := The_Project.Decl.Arrays;
 814                         end if;
 815
 816                         while The_Array /= No_Array
 817                           and then Shared.Arrays.Table (The_Array).Name /=
 818                                                                     The_Name
 819                         loop
 820                            The_Array := Shared.Arrays.Table (The_Array).Next;
 821                         end loop;
 822
 823                         if The_Array /= No_Array then
 824                            The_Element :=
 825                              Shared.Arrays.Table (The_Array).Value;
 826                            Array_Index :=
 827                              Get_Attribute_Index
 828                                (From_Project_Node_Tree,
 829                                 The_Current_Term,
 830                                 Index);
 831
 832                            while The_Element /= No_Array_Element
 833                              and then Shared.Array_Elements.Table
 834                                         (The_Element).Index /= Array_Index
 835                            loop
 836                               The_Element :=
 837                                 Shared.Array_Elements.Table (The_Element).Next;
 838                            end loop;
 839
 840                         end if;
 841
 842                         if The_Element /= No_Array_Element then
 843                            The_Variable :=
 844                              Shared.Array_Elements.Table (The_Element).Value;
 845
 846                         else
 847                            if Expression_Kind_Of
 848                                 (The_Current_Term, From_Project_Node_Tree) =
 849                                                                         List
 850                            then
 851                               The_Variable :=
 852                                 (Project  => Project,
 853                                  Kind     => List,
 854                                  Location => No_Location,
 855                                  Default  => True,
 856                                  Values   => Nil_String);
 857                            else
 858                               The_Variable :=
 859                                 (Project  => Project,
 860                                  Kind     => Single,
 861                                  Location => No_Location,
 862                                  Default  => True,
 863                                  Value    => Empty_String,
 864                                  Index    => 0);
 865                            end if;
 866                         end if;
 867                      end;
 868                   end if;
 869
 870                   case Kind is
 871
 872                      when Undefined =>
 873
 874                         --  Should never happen
 875
 876                         pragma Assert (False, "undefined expression kind");
 877                         null;
 878
 879                      when Single =>
 880
 881                         case The_Variable.Kind is
 882
 883                            when Undefined =>
 884                               null;
 885
 886                            when Single =>
 887                               Add (Result.Value, The_Variable.Value);
 888
 889                            when List =>
 890
 891                               --  Should never happen
 892
 893                               pragma Assert
 894                                 (False,
 895                                  "list cannot appear in single " &
 896                                  "string expression");
 897                               null;
 898                         end case;
 899
 900                      when List =>
 901                         case The_Variable.Kind is
 902
 903                            when Undefined =>
 904                               null;
 905
 906                            when Single =>
 907                               String_Element_Table.Increment_Last
 908                                 (Shared.String_Elements);
 909
 910                               if Last = Nil_String then
 911
 912                                  --  This can happen in an expression such as
 913                                  --  () & Var
 914
 915                                  Result.Values :=
 916                                    String_Element_Table.Last
 917                                      (Shared.String_Elements);
 918
 919                               else
 920                                  Shared.String_Elements.Table (Last).Next :=
 921                                      String_Element_Table.Last
 922                                        (Shared.String_Elements);
 923                               end if;
 924
 925                               Last :=
 926                                 String_Element_Table.Last
 927                                   (Shared.String_Elements);
 928
 929                               Shared.String_Elements.Table (Last) :=
 930                                 (Value         => The_Variable.Value,
 931                                  Display_Value => No_Name,
 932                                  Location      => Location_Of
 933                                                     (The_Current_Term,
 934                                                      From_Project_Node_Tree),
 935                                  Flag          => False,
 936                                  Next          => Nil_String,
 937                                  Index         => 0);
 938
 939                            when List =>
 940
 941                               declare
 942                                  The_List : String_List_Id :=
 943                                               The_Variable.Values;
 944
 945                               begin
 946                                  while The_List /= Nil_String loop
 947                                     String_Element_Table.Increment_Last
 948                                       (Shared.String_Elements);
 949
 950                                     if Last = Nil_String then
 951                                        Result.Values :=
 952                                          String_Element_Table.Last
 953                                            (Shared.String_Elements);
 954
 955                                     else
 956                                        Shared.
 957                                          String_Elements.Table (Last).Next :=
 958                                          String_Element_Table.Last
 959                                            (Shared.String_Elements);
 960
 961                                     end if;
 962
 963                                     Last :=
 964                                       String_Element_Table.Last
 965                                         (Shared.String_Elements);
 966
 967                                     Shared.String_Elements.Table
 968                                       (Last) :=
 969                                       (Value         =>
 970                                          Shared.String_Elements.Table
 971                                            (The_List).Value,
 972                                        Display_Value => No_Name,
 973                                        Location      =>
 974                                          Location_Of
 975                                            (The_Current_Term,
 976                                             From_Project_Node_Tree),
 977                                        Flag         => False,
 978                                        Next         => Nil_String,
 979                                        Index        => 0);
 980
 981                                     The_List := Shared.String_Elements.Table
 982                                         (The_List).Next;
 983                                  end loop;
 984                               end;
 985                         end case;
 986                   end case;
 987                end;
 988
 989             when N_External_Value =>
 990                Get_Name_String
 991                  (String_Value_Of
 992                     (External_Reference_Of
 993                        (The_Current_Term, From_Project_Node_Tree),
 994                      From_Project_Node_Tree));
 995
 996                declare
 997                   Name     : constant Name_Id   := Name_Find;
 998                   Default  : Name_Id            := No_Name;
 999                   Value    : Name_Id            := No_Name;
1000                   Ext_List : Boolean            := False;
1001                   Str_List : String_List_Access := null;
1002                   Def_Var  : Variable_Value;
1003
1004                   Default_Node : constant Project_Node_Id :=
1005                                    External_Default_Of
1006                                      (The_Current_Term,
1007                                       From_Project_Node_Tree);
1008
1009                begin
1010                   --  If there is a default value for the external reference,
1011                   --  get its value.
1012
1013                   if Present (Default_Node) then
1014                      Def_Var := Expression
1015                        (Project                => Project,
1016                         Shared                 => Shared,
1017                         From_Project_Node      => From_Project_Node,
1018                         From_Project_Node_Tree => From_Project_Node_Tree,
1019                         Env                    => Env,
1020                         Pkg                    => Pkg,
1021                         First_Term             =>
1022                           Tree.First_Term
1023                             (Default_Node, From_Project_Node_Tree),
1024                         Kind                   => Single);
1025
1026                      if Def_Var /= Nil_Variable_Value then
1027                         Default := Def_Var.Value;
1028                      end if;
1029                   end if;
1030
1031                   Ext_List := Expression_Kind_Of
1032                                 (The_Current_Term,
1033                                  From_Project_Node_Tree) = List;
1034
1035                   if Ext_List then
1036                      Value := Prj.Ext.Value_Of (Env.External, Name, No_Name);
1037
1038                      if Value /= No_Name then
1039                         declare
1040                            Sep   : constant String :=
1041                                      Get_Name_String (Default);
1042                            First : Positive := 1;
1043                            Lst   : Natural;
1044                            Done  : Boolean := False;
1045                            Nmb   : Natural;
1046
1047                         begin
1048                            Get_Name_String (Value);
1049
1050                            if Name_Len = 0
1051                              or else Sep'Length = 0
1052                              or else Name_Buffer (1 .. Name_Len) = Sep
1053                            then
1054                               Done := True;
1055                            end if;
1056
1057                            if not Done and then Name_Len < Sep'Length then
1058                               Str_List :=
1059                                 new String_List'
1060                                   (1 => new String'
1061                                        (Name_Buffer (1 .. Name_Len)));
1062                               Done := True;
1063                            end if;
1064
1065                            if not Done then
1066                               if Name_Buffer (1 .. Sep'Length) = Sep then
1067                                  First := Sep'Length + 1;
1068                               end if;
1069
1070                               if Name_Len - First + 1 >= Sep'Length
1071                                 and then
1072                                   Name_Buffer (Name_Len - Sep'Length + 1 ..
1073                                                    Name_Len) = Sep
1074                               then
1075                                  Name_Len := Name_Len - Sep'Length;
1076                               end if;
1077
1078                               if Name_Len = 0 then
1079                                  Str_List :=
1080                                    new String_List'(1 => new String'(""));
1081                                  Done := True;
1082                               end if;
1083                            end if;
1084
1085                            if not Done then
1086
1087                               --  Count the number of strings
1088
1089                               declare
1090                                  Saved : constant Positive := First;
1091
1092                               begin
1093                                  Nmb := 1;
1094                                  loop
1095                                     Lst :=
1096                                       Index
1097                                         (Source  =>
1098                                              Name_Buffer (First .. Name_Len),
1099                                          Pattern => Sep);
1100                                     exit when Lst = 0;
1101                                     Nmb := Nmb + 1;
1102                                     First := Lst + Sep'Length;
1103                                  end loop;
1104
1105                                  First := Saved;
1106                               end;
1107
1108                               Str_List := new String_List (1 .. Nmb);
1109
1110                               --  Populate the string list
1111
1112                               Nmb := 1;
1113                               loop
1114                                  Lst :=
1115                                    Index
1116                                      (Source  =>
1117                                           Name_Buffer (First .. Name_Len),
1118                                       Pattern => Sep);
1119
1120                                  if Lst = 0 then
1121                                     Str_List (Nmb) :=
1122                                       new String'
1123                                         (Name_Buffer (First .. Name_Len));
1124                                     exit;
1125
1126                                  else
1127                                     Str_List (Nmb) :=
1128                                       new String'
1129                                         (Name_Buffer (First .. Lst - 1));
1130                                     Nmb := Nmb + 1;
1131                                     First := Lst + Sep'Length;
1132                                  end if;
1133                               end loop;
1134                            end if;
1135                         end;
1136                      end if;
1137
1138                   else
1139                      --  Get the value
1140
1141                      Value := Prj.Ext.Value_Of (Env.External, Name, Default);
1142
1143                      if Value = No_Name then
1144                         if not Quiet_Output then
1145                            Error_Msg
1146                              (Env.Flags, "?undefined external reference",
1147                               Location_Of
1148                                 (The_Current_Term, From_Project_Node_Tree),
1149                               Project);
1150                         end if;
1151
1152                         Value := Empty_String;
1153                      end if;
1154                   end if;
1155
1156                   case Kind is
1157
1158                      when Undefined =>
1159                         null;
1160
1161                      when Single =>
1162                         if Ext_List then
1163                            null; -- error
1164
1165                         else
1166                            Add (Result.Value, Value);
1167                         end if;
1168
1169                      when List =>
1170                         if not Ext_List or else Str_List /= null then
1171                            String_Element_Table.Increment_Last
1172                              (Shared.String_Elements);
1173
1174                            if Last = Nil_String then
1175                               Result.Values :=
1176                                 String_Element_Table.Last
1177                                   (Shared.String_Elements);
1178
1179                            else
1180                               Shared.String_Elements.Table (Last).Next
1181                                 := String_Element_Table.Last
1182                                   (Shared.String_Elements);
1183                            end if;
1184
1185                            Last := String_Element_Table.Last
1186                              (Shared.String_Elements);
1187
1188                            if Ext_List then
1189                               for Ind in Str_List'Range loop
1190                                  Name_Len := 0;
1191                                  Add_Str_To_Name_Buffer (Str_List (Ind).all);
1192                                  Value := Name_Find;
1193                                  Shared.String_Elements.Table (Last) :=
1194                                    (Value         => Value,
1195                                     Display_Value => No_Name,
1196                                     Location      =>
1197                                       Location_Of
1198                                         (The_Current_Term,
1199                                          From_Project_Node_Tree),
1200                                     Flag          => False,
1201                                     Next          => Nil_String,
1202                                     Index         => 0);
1203
1204                                  if Ind /= Str_List'Last then
1205                                     String_Element_Table.Increment_Last
1206                                       (Shared.String_Elements);
1207                                     Shared.String_Elements.Table (Last).Next :=
1208                                         String_Element_Table.Last
1209                                           (Shared.String_Elements);
1210                                     Last := String_Element_Table.Last
1211                                         (Shared.String_Elements);
1212                                  end if;
1213                               end loop;
1214
1215                            else
1216                               Shared.String_Elements.Table (Last) :=
1217                                 (Value         => Value,
1218                                  Display_Value => No_Name,
1219                                  Location      =>
1220                                    Location_Of
1221                                      (The_Current_Term,
1222                                       From_Project_Node_Tree),
1223                                  Flag          => False,
1224                                  Next          => Nil_String,
1225                                  Index         => 0);
1226                            end if;
1227                         end if;
1228                   end case;
1229                end;
1230
1231             when others =>
1232
1233                --  Should never happen
1234
1235                pragma Assert
1236                  (False,
1237                   "illegal node kind in an expression");
1238                raise Program_Error;
1239
1240          end case;
1241
1242          The_Term := Next_Term (The_Term, From_Project_Node_Tree);
1243       end loop;
1244
1245       return Result;
1246    end Expression;
1247
1248    ---------------------------------------
1249    -- Imported_Or_Extended_Project_From --
1250    ---------------------------------------
1251
1252    function Imported_Or_Extended_Project_From
1253      (Project   : Project_Id;
1254       With_Name : Name_Id) return Project_Id
1255    is
1256       List        : Project_List;
1257       Result      : Project_Id;
1258       Temp_Result : Project_Id;
1259
1260    begin
1261       --  First check if it is the name of an extended project
1262
1263       Result := Project.Extends;
1264       while Result /= No_Project loop
1265          if Result.Name = With_Name then
1266             return Result;
1267          else
1268             Result := Result.Extends;
1269          end if;
1270       end loop;
1271
1272       --  Then check the name of each imported project
1273
1274       Temp_Result := No_Project;
1275       List := Project.Imported_Projects;
1276       while List /= null loop
1277          Result := List.Project;
1278
1279          --  If the project is directly imported, then returns its ID
1280
1281          if Result.Name = With_Name then
1282             return Result;
1283          end if;
1284
1285          --  If a project extending the project is imported, then keep this
1286          --  extending project as a possibility. It will be the returned ID
1287          --  if the project is not imported directly.
1288
1289          declare
1290             Proj : Project_Id;
1291
1292          begin
1293             Proj := Result.Extends;
1294             while Proj /= No_Project loop
1295                if Proj.Name = With_Name then
1296                   Temp_Result := Result;
1297                   exit;
1298                end if;
1299
1300                Proj := Proj.Extends;
1301             end loop;
1302          end;
1303
1304          List := List.Next;
1305       end loop;
1306
1307       pragma Assert (Temp_Result /= No_Project, "project not found");
1308       return Temp_Result;
1309    end Imported_Or_Extended_Project_From;
1310
1311    ------------------
1312    -- Package_From --
1313    ------------------
1314
1315    function Package_From
1316      (Project   : Project_Id;
1317       Shared    : Shared_Project_Tree_Data_Access;
1318       With_Name : Name_Id) return Package_Id
1319    is
1320       Result : Package_Id := Project.Decl.Packages;
1321
1322    begin
1323       --  Check the name of each existing package of Project
1324
1325       while Result /= No_Package
1326         and then Shared.Packages.Table (Result).Name /= With_Name
1327       loop
1328          Result := Shared.Packages.Table (Result).Next;
1329       end loop;
1330
1331       if Result = No_Package then
1332
1333          --  Should never happen
1334
1335          Write_Line
1336            ("package """ & Get_Name_String (With_Name) & """ not found");
1337          raise Program_Error;
1338
1339       else
1340          return Result;
1341       end if;
1342    end Package_From;
1343
1344    -------------
1345    -- Process --
1346    -------------
1347
1348    procedure Process
1349      (In_Tree                : Project_Tree_Ref;
1350       Project                : out Project_Id;
1351       Packages_To_Check      : String_List_Access;
1352       Success                : out Boolean;
1353       From_Project_Node      : Project_Node_Id;
1354       From_Project_Node_Tree : Project_Node_Tree_Ref;
1355       Env                    : in out Prj.Tree.Environment;
1356       Reset_Tree             : Boolean := True)
1357    is
1358    begin
1359       Process_Project_Tree_Phase_1
1360         (In_Tree                => In_Tree,
1361          Project                => Project,
1362          Success                => Success,
1363          From_Project_Node      => From_Project_Node,
1364          From_Project_Node_Tree => From_Project_Node_Tree,
1365          Env                    => Env,
1366          Packages_To_Check      => Packages_To_Check,
1367          Reset_Tree             => Reset_Tree);
1368
1369       if Project_Qualifier_Of
1370            (From_Project_Node, From_Project_Node_Tree) /= Configuration
1371       then
1372          Process_Project_Tree_Phase_2
1373            (In_Tree                => In_Tree,
1374             Project                => Project,
1375             Success                => Success,
1376             From_Project_Node      => From_Project_Node,
1377             From_Project_Node_Tree => From_Project_Node_Tree,
1378             Env                    => Env);
1379       end if;
1380    end Process;
1381
1382    -------------------------------
1383    -- Process_Declarative_Items --
1384    -------------------------------
1385
1386    procedure Process_Declarative_Items
1387      (Project           : Project_Id;
1388       In_Tree           : Project_Tree_Ref;
1389       From_Project_Node : Project_Node_Id;
1390       Node_Tree         : Project_Node_Tree_Ref;
1391       Env               : Prj.Tree.Environment;
1392       Pkg               : Package_Id;
1393       Item              : Project_Node_Id;
1394       Child_Env         : in out Prj.Tree.Environment)
1395    is
1396       Shared : constant Shared_Project_Tree_Data_Access := In_Tree.Shared;
1397
1398       procedure Check_Or_Set_Typed_Variable
1399         (Value       : in out Variable_Value;
1400          Declaration : Project_Node_Id);
1401       --  Check whether Value is valid for this typed variable declaration. If
1402       --  it is an error, the behavior depends on the flags: either an error is
1403       --  reported, or a warning, or nothing. In the last two cases, the value
1404       --  of the variable is set to a valid value, replacing Value.
1405
1406       procedure Process_Package_Declaration
1407         (Current_Item : Project_Node_Id);
1408       procedure Process_Attribute_Declaration
1409         (Current : Project_Node_Id);
1410       procedure Process_Case_Construction
1411         (Current_Item : Project_Node_Id);
1412       procedure Process_Associative_Array
1413         (Current_Item : Project_Node_Id);
1414       procedure Process_Expression
1415         (Current : Project_Node_Id);
1416       procedure Process_Expression_For_Associative_Array
1417         (Current : Project_Node_Id;
1418          New_Value    : Variable_Value);
1419       procedure Process_Expression_Variable_Decl
1420         (Current_Item : Project_Node_Id;
1421          New_Value    : Variable_Value);
1422       --  Process the various declarative items
1423
1424       ---------------------------------
1425       -- Check_Or_Set_Typed_Variable --
1426       ---------------------------------
1427
1428       procedure Check_Or_Set_Typed_Variable
1429         (Value       : in out Variable_Value;
1430          Declaration : Project_Node_Id)
1431       is
1432          Loc : constant Source_Ptr := Location_Of (Declaration, Node_Tree);
1433
1434          Reset_Value    : Boolean := False;
1435          Current_String : Project_Node_Id;
1436
1437       begin
1438          --  Report an error for an empty string
1439
1440          if Value.Value = Empty_String then
1441             Error_Msg_Name_1 := Name_Of (Declaration, Node_Tree);
1442
1443             case Env.Flags.Allow_Invalid_External is
1444                when Error =>
1445                   Error_Msg
1446                     (Env.Flags, "no value defined for %%", Loc, Project);
1447                when Warning =>
1448                   Reset_Value := True;
1449                   Error_Msg
1450                     (Env.Flags, "?no value defined for %%", Loc, Project);
1451                when Silent =>
1452                   Reset_Value := True;
1453             end case;
1454
1455          else
1456             --  Loop through all the valid strings for the
1457             --  string type and compare to the string value.
1458
1459             Current_String :=
1460               First_Literal_String
1461                 (String_Type_Of (Declaration, Node_Tree), Node_Tree);
1462
1463             while Present (Current_String)
1464               and then
1465                 String_Value_Of (Current_String, Node_Tree) /= Value.Value
1466             loop
1467                Current_String :=
1468                  Next_Literal_String (Current_String, Node_Tree);
1469             end loop;
1470
1471             --  Report error if string value is not one for the string type
1472
1473             if No (Current_String) then
1474                Error_Msg_Name_1 := Value.Value;
1475                Error_Msg_Name_2 := Name_Of (Declaration, Node_Tree);
1476
1477                case Env.Flags.Allow_Invalid_External is
1478                   when Error =>
1479                      Error_Msg
1480                        (Env.Flags, "value %% is illegal for typed string %%",
1481                         Loc, Project);
1482
1483                   when Warning =>
1484                      Error_Msg
1485                        (Env.Flags, "?value %% is illegal for typed string %%",
1486                         Loc, Project);
1487                      Reset_Value := True;
1488
1489                   when Silent =>
1490                      Reset_Value := True;
1491                end case;
1492             end if;
1493          end if;
1494
1495          if Reset_Value then
1496             Current_String :=
1497               First_Literal_String
1498                 (String_Type_Of (Declaration, Node_Tree), Node_Tree);
1499             Value.Value := String_Value_Of (Current_String, Node_Tree);
1500          end if;
1501       end Check_Or_Set_Typed_Variable;
1502
1503       ---------------------------------
1504       -- Process_Package_Declaration --
1505       ---------------------------------
1506
1507       procedure Process_Package_Declaration
1508         (Current_Item : Project_Node_Id)
1509       is
1510       begin
1511          --  Do not process a package declaration that should be ignored
1512
1513          if Expression_Kind_Of (Current_Item, Node_Tree) /= Ignored then
1514
1515             --  Create the new package
1516
1517             Package_Table.Increment_Last (Shared.Packages);
1518
1519             declare
1520                New_Pkg         : constant Package_Id :=
1521                                   Package_Table.Last (Shared.Packages);
1522                The_New_Package : Package_Element;
1523
1524                Project_Of_Renamed_Package : constant Project_Node_Id :=
1525                                               Project_Of_Renamed_Package_Of
1526                                                 (Current_Item, Node_Tree);
1527
1528             begin
1529                --  Set the name of the new package
1530
1531                The_New_Package.Name := Name_Of (Current_Item, Node_Tree);
1532
1533                --  Insert the new package in the appropriate list
1534
1535                if Pkg /= No_Package then
1536                   The_New_Package.Next :=
1537                     Shared.Packages.Table (Pkg).Decl.Packages;
1538                   Shared.Packages.Table (Pkg).Decl.Packages := New_Pkg;
1539
1540                else
1541                   The_New_Package.Next  := Project.Decl.Packages;
1542                   Project.Decl.Packages := New_Pkg;
1543                end if;
1544
1545                Shared.Packages.Table (New_Pkg) := The_New_Package;
1546
1547                if Present (Project_Of_Renamed_Package) then
1548
1549                   --  Renamed or extending package
1550
1551                   declare
1552                      Project_Name : constant Name_Id :=
1553                                       Name_Of (Project_Of_Renamed_Package,
1554                                                Node_Tree);
1555
1556                      Renamed_Project : constant Project_Id :=
1557                                          Imported_Or_Extended_Project_From
1558                                            (Project, Project_Name);
1559
1560                      Renamed_Package : constant Package_Id :=
1561                                          Package_From
1562                                            (Renamed_Project, Shared,
1563                                             Name_Of (Current_Item, Node_Tree));
1564
1565                   begin
1566                      --  For a renamed package, copy the declarations of the
1567                      --  renamed package, but set all the locations to the
1568                      --  location of the package name in the renaming
1569                      --  declaration.
1570
1571                      Copy_Package_Declarations
1572                        (From       => Shared.Packages.Table
1573                                         (Renamed_Package).Decl,
1574                         To         => Shared.Packages.Table (New_Pkg).Decl,
1575                         New_Loc    => Location_Of (Current_Item, Node_Tree),
1576                         Restricted => False,
1577                         Shared     => Shared);
1578                   end;
1579
1580                else
1581                   --  Set the default values of the attributes
1582
1583                   Add_Attributes
1584                     (Project,
1585                      Project.Name,
1586                      Name_Id (Project.Directory.Name),
1587                      Shared,
1588                      Shared.Packages.Table (New_Pkg).Decl,
1589                      First_Attribute_Of
1590                        (Package_Id_Of (Current_Item, Node_Tree)),
1591                      Project_Level => False);
1592                end if;
1593
1594                --  Process declarative items (nothing to do when the package is
1595                --  renaming, as the first declarative item is null).
1596
1597                Process_Declarative_Items
1598                  (Project                => Project,
1599                   In_Tree                => In_Tree,
1600                   From_Project_Node      => From_Project_Node,
1601                   Node_Tree              => Node_Tree,
1602                   Env                    => Env,
1603                   Pkg                    => New_Pkg,
1604                   Item                   =>
1605                     First_Declarative_Item_Of (Current_Item, Node_Tree),
1606                   Child_Env              => Child_Env);
1607             end;
1608          end if;
1609       end Process_Package_Declaration;
1610
1611       -------------------------------
1612       -- Process_Associative_Array --
1613       -------------------------------
1614
1615       procedure Process_Associative_Array
1616         (Current_Item : Project_Node_Id)
1617       is
1618          Current_Item_Name : constant Name_Id :=
1619                                Name_Of (Current_Item, Node_Tree);
1620          --  The name of the attribute
1621
1622          Current_Location  : constant Source_Ptr :=
1623                                Location_Of (Current_Item, Node_Tree);
1624
1625          New_Array : Array_Id;
1626          --  The new associative array created
1627
1628          Orig_Array : Array_Id;
1629          --  The associative array value
1630
1631          Orig_Project_Name : Name_Id := No_Name;
1632          --  The name of the project where the associative array
1633          --  value is.
1634
1635          Orig_Project : Project_Id := No_Project;
1636          --  The id of the project where the associative array
1637          --  value is.
1638
1639          Orig_Package_Name : Name_Id := No_Name;
1640          --  The name of the package, if any, where the associative array value
1641          --  is located.
1642
1643          Orig_Package : Package_Id := No_Package;
1644          --  The id of the package, if any, where the associative array value
1645          --  is located.
1646
1647          New_Element : Array_Element_Id := No_Array_Element;
1648          --  Id of a new array element created
1649
1650          Prev_Element : Array_Element_Id := No_Array_Element;
1651          --  Last new element id created
1652
1653          Orig_Element : Array_Element_Id := No_Array_Element;
1654          --  Current array element in original associative array
1655
1656          Next_Element : Array_Element_Id := No_Array_Element;
1657          --  Id of the array element that follows the new element. This is not
1658          --  always nil, because values for the associative array attribute may
1659          --  already have been declared, and the array elements declared are
1660          --  reused.
1661
1662          Prj : Project_List;
1663
1664       begin
1665          --  First find if the associative array attribute already has elements
1666          --  declared.
1667
1668          if Pkg /= No_Package then
1669             New_Array := Shared.Packages.Table (Pkg).Decl.Arrays;
1670          else
1671             New_Array := Project.Decl.Arrays;
1672          end if;
1673
1674          while New_Array /= No_Array
1675            and then Shared.Arrays.Table (New_Array).Name /= Current_Item_Name
1676          loop
1677             New_Array := Shared.Arrays.Table (New_Array).Next;
1678          end loop;
1679
1680          --  If the attribute has never been declared add new entry in the
1681          --  arrays of the project/package and link it.
1682
1683          if New_Array = No_Array then
1684             Array_Table.Increment_Last (Shared.Arrays);
1685             New_Array := Array_Table.Last (Shared.Arrays);
1686
1687             if Pkg /= No_Package then
1688                Shared.Arrays.Table (New_Array) :=
1689                  (Name     => Current_Item_Name,
1690                   Location => Current_Location,
1691                   Value    => No_Array_Element,
1692                   Next     => Shared.Packages.Table (Pkg).Decl.Arrays);
1693
1694                Shared.Packages.Table (Pkg).Decl.Arrays := New_Array;
1695
1696             else
1697                Shared.Arrays.Table (New_Array) :=
1698                  (Name     => Current_Item_Name,
1699                   Location => Current_Location,
1700                   Value    => No_Array_Element,
1701                   Next     => Project.Decl.Arrays);
1702
1703                Project.Decl.Arrays := New_Array;
1704             end if;
1705          end if;
1706
1707          --  Find the project where the value is declared
1708
1709          Orig_Project_Name :=
1710            Name_Of
1711              (Associative_Project_Of (Current_Item, Node_Tree), Node_Tree);
1712
1713          Prj := In_Tree.Projects;
1714          while Prj /= null loop
1715             if Prj.Project.Name = Orig_Project_Name then
1716                Orig_Project := Prj.Project;
1717                exit;
1718             end if;
1719             Prj := Prj.Next;
1720          end loop;
1721
1722          pragma Assert (Orig_Project /= No_Project,
1723                         "original project not found");
1724
1725          if No (Associative_Package_Of (Current_Item, Node_Tree)) then
1726             Orig_Array := Orig_Project.Decl.Arrays;
1727
1728          else
1729             --  If in a package, find the package where the value is declared
1730
1731             Orig_Package_Name :=
1732               Name_Of
1733                 (Associative_Package_Of (Current_Item, Node_Tree), Node_Tree);
1734
1735             Orig_Package := Orig_Project.Decl.Packages;
1736             pragma Assert (Orig_Package /= No_Package,
1737                            "original package not found");
1738
1739             while Shared.Packages.Table
1740               (Orig_Package).Name /= Orig_Package_Name
1741             loop
1742                Orig_Package := Shared.Packages.Table (Orig_Package).Next;
1743                pragma Assert (Orig_Package /= No_Package,
1744                               "original package not found");
1745             end loop;
1746
1747             Orig_Array := Shared.Packages.Table (Orig_Package).Decl.Arrays;
1748          end if;
1749
1750          --  Now look for the array
1751
1752          while Orig_Array /= No_Array
1753            and then Shared.Arrays.Table (Orig_Array).Name /= Current_Item_Name
1754          loop
1755             Orig_Array := Shared.Arrays.Table (Orig_Array).Next;
1756          end loop;
1757
1758          if Orig_Array = No_Array then
1759             Error_Msg
1760               (Env.Flags,
1761                "associative array value not found",
1762                Location_Of (Current_Item, Node_Tree),
1763                Project);
1764
1765          else
1766             Orig_Element := Shared.Arrays.Table (Orig_Array).Value;
1767
1768             --  Copy each array element
1769
1770             while Orig_Element /= No_Array_Element loop
1771
1772                --  Case of first element
1773
1774                if Prev_Element = No_Array_Element then
1775
1776                   --  And there is no array element declared yet, create a new
1777                   --  first array element.
1778
1779                   if Shared.Arrays.Table (New_Array).Value =
1780                     No_Array_Element
1781                   then
1782                      Array_Element_Table.Increment_Last
1783                        (Shared.Array_Elements);
1784                      New_Element := Array_Element_Table.Last
1785                        (Shared.Array_Elements);
1786                      Shared.Arrays.Table (New_Array).Value := New_Element;
1787                      Next_Element := No_Array_Element;
1788
1789                      --  Otherwise, the new element is the first
1790
1791                   else
1792                      New_Element := Shared.Arrays.Table (New_Array).Value;
1793                      Next_Element :=
1794                        Shared.Array_Elements.Table (New_Element).Next;
1795                   end if;
1796
1797                   --  Otherwise, reuse an existing element, or create
1798                   --  one if necessary.
1799
1800                else
1801                   Next_Element :=
1802                     Shared.Array_Elements.Table (Prev_Element).Next;
1803
1804                   if Next_Element = No_Array_Element then
1805                      Array_Element_Table.Increment_Last
1806                        (Shared.Array_Elements);
1807                      New_Element := Array_Element_Table.Last
1808                        (Shared.Array_Elements);
1809                      Shared.Array_Elements.Table (Prev_Element).Next :=
1810                        New_Element;
1811
1812                   else
1813                      New_Element := Next_Element;
1814                      Next_Element :=
1815                        Shared.Array_Elements.Table (New_Element).Next;
1816                   end if;
1817                end if;
1818
1819                --  Copy the value of the element
1820
1821                Shared.Array_Elements.Table (New_Element) :=
1822                  Shared.Array_Elements.Table (Orig_Element);
1823                Shared.Array_Elements.Table (New_Element).Value.Project
1824                  := Project;
1825
1826                --  Adjust the Next link
1827
1828                Shared.Array_Elements.Table (New_Element).Next := Next_Element;
1829
1830                --  Adjust the previous id for the next element
1831
1832                Prev_Element := New_Element;
1833
1834                --  Go to the next element in the original array
1835
1836                Orig_Element := Shared.Array_Elements.Table (Orig_Element).Next;
1837             end loop;
1838
1839             --  Make sure that the array ends here, in case there previously a
1840             --  greater number of elements.
1841
1842             Shared.Array_Elements.Table (New_Element).Next := No_Array_Element;
1843          end if;
1844       end Process_Associative_Array;
1845
1846       ----------------------------------------------
1847       -- Process_Expression_For_Associative_Array --
1848       ----------------------------------------------
1849
1850       procedure Process_Expression_For_Associative_Array
1851         (Current   : Project_Node_Id;
1852          New_Value : Variable_Value)
1853       is
1854          Name             : constant Name_Id := Name_Of (Current, Node_Tree);
1855          Current_Location : constant Source_Ptr :=
1856                               Location_Of (Current, Node_Tree);
1857
1858          Index_Name : Name_Id :=
1859                         Associative_Array_Index_Of (Current, Node_Tree);
1860
1861          Source_Index : constant Int :=
1862                           Source_Index_Of (Current, Node_Tree);
1863
1864          The_Array : Array_Id;
1865          Elem      : Array_Element_Id := No_Array_Element;
1866
1867       begin
1868          if Index_Name /= All_Other_Names then
1869             Index_Name := Get_Attribute_Index (Node_Tree, Current, Index_Name);
1870          end if;
1871
1872          --  Look for the array in the appropriate list
1873
1874          if Pkg /= No_Package then
1875             The_Array := Shared.Packages.Table (Pkg).Decl.Arrays;
1876          else
1877             The_Array := Project.Decl.Arrays;
1878          end if;
1879
1880          while The_Array /= No_Array
1881            and then Shared.Arrays.Table (The_Array).Name /= Name
1882          loop
1883             The_Array := Shared.Arrays.Table (The_Array).Next;
1884          end loop;
1885
1886          --  If the array cannot be found, create a new entry in the list.
1887          --  As The_Array_Element is initialized to No_Array_Element, a new
1888          --  element will be created automatically later
1889
1890          if The_Array = No_Array then
1891             Array_Table.Increment_Last (Shared.Arrays);
1892             The_Array := Array_Table.Last (Shared.Arrays);
1893
1894             if Pkg /= No_Package then
1895                Shared.Arrays.Table (The_Array) :=
1896                  (Name     => Name,
1897                   Location => Current_Location,
1898                   Value    => No_Array_Element,
1899                   Next     => Shared.Packages.Table (Pkg).Decl.Arrays);
1900
1901                Shared.Packages.Table (Pkg).Decl.Arrays := The_Array;
1902
1903             else
1904                Shared.Arrays.Table (The_Array) :=
1905                  (Name     => Name,
1906                   Location => Current_Location,
1907                   Value    => No_Array_Element,
1908                   Next     => Project.Decl.Arrays);
1909
1910                Project.Decl.Arrays := The_Array;
1911             end if;
1912
1913          else
1914             Elem := Shared.Arrays.Table (The_Array).Value;
1915          end if;
1916
1917          --  Look in the list, if any, to find an element with the same index
1918          --  and same source index.
1919
1920          while Elem /= No_Array_Element
1921            and then
1922              (Shared.Array_Elements.Table (Elem).Index /= Index_Name
1923                or else
1924                  Shared.Array_Elements.Table (Elem).Src_Index /= Source_Index)
1925          loop
1926             Elem := Shared.Array_Elements.Table (Elem).Next;
1927          end loop;
1928
1929          --  If no such element were found, create a new one
1930          --  and insert it in the element list, with the
1931          --  proper value.
1932
1933          if Elem = No_Array_Element then
1934             Array_Element_Table.Increment_Last (Shared.Array_Elements);
1935             Elem := Array_Element_Table.Last (Shared.Array_Elements);
1936
1937             Shared.Array_Elements.Table
1938               (Elem) :=
1939               (Index                => Index_Name,
1940                Restricted           => False,
1941                Src_Index            => Source_Index,
1942                Index_Case_Sensitive =>
1943                   not Case_Insensitive (Current, Node_Tree),
1944                Value                => New_Value,
1945                Next                 => Shared.Arrays.Table (The_Array).Value);
1946
1947             Shared.Arrays.Table (The_Array).Value := Elem;
1948
1949          else
1950             --  An element with the same index already exists, just replace its
1951             --  value with the new one.
1952
1953             Shared.Array_Elements.Table (Elem).Value := New_Value;
1954          end if;
1955
1956          if Name = Snames.Name_External then
1957             if In_Tree.Is_Root_Tree then
1958                Add (Child_Env.External,
1959                     External_Name => Get_Name_String (Index_Name),
1960                     Value         => Get_Name_String (New_Value.Value),
1961                     Source        => From_External_Attribute);
1962                Add (Env.External,
1963                     External_Name => Get_Name_String (Index_Name),
1964                     Value         => Get_Name_String (New_Value.Value),
1965                     Source        => From_External_Attribute);
1966             else
1967                if Current_Verbosity = High then
1968                   Debug_Output
1969                     ("'for External' has no effect except in root aggregate ("
1970                      & Get_Name_String (Index_Name) & ")", New_Value.Value);
1971                end if;
1972             end if;
1973          end if;
1974       end Process_Expression_For_Associative_Array;
1975
1976       --------------------------------------
1977       -- Process_Expression_Variable_Decl --
1978       --------------------------------------
1979
1980       procedure Process_Expression_Variable_Decl
1981         (Current_Item : Project_Node_Id;
1982          New_Value    : Variable_Value)
1983       is
1984          Name : constant Name_Id := Name_Of (Current_Item, Node_Tree);
1985
1986          Is_Attribute : constant Boolean :=
1987                           Kind_Of (Current_Item, Node_Tree) =
1988                             N_Attribute_Declaration;
1989
1990          Var  : Variable_Id := No_Variable;
1991
1992       begin
1993          --  First, find the list where to find the variable or attribute
1994
1995          if Is_Attribute then
1996             if Pkg /= No_Package then
1997                Var := Shared.Packages.Table (Pkg).Decl.Attributes;
1998             else
1999                Var := Project.Decl.Attributes;
2000             end if;
2001
2002          else
2003             if Pkg /= No_Package then
2004                Var := Shared.Packages.Table (Pkg).Decl.Variables;
2005             else
2006                Var := Project.Decl.Variables;
2007             end if;
2008          end if;
2009
2010          --  Loop through the list, to find if it has already been declared
2011
2012          while Var /= No_Variable
2013            and then Shared.Variable_Elements.Table (Var).Name /= Name
2014          loop
2015             Var := Shared.Variable_Elements.Table (Var).Next;
2016          end loop;
2017
2018          --  If it has not been declared, create a new entry in the list
2019
2020          if Var = No_Variable then
2021
2022             --  All single string attribute should already have been declared
2023             --  with a default empty string value.
2024
2025             pragma Assert
2026               (not Is_Attribute,
2027                "illegal attribute declaration for " & Get_Name_String (Name));
2028
2029             Variable_Element_Table.Increment_Last (Shared.Variable_Elements);
2030             Var := Variable_Element_Table.Last (Shared.Variable_Elements);
2031
2032             --  Put the new variable in the appropriate list
2033
2034             if Pkg /= No_Package then
2035                Shared.Variable_Elements.Table (Var) :=
2036                  (Next   => Shared.Packages.Table (Pkg).Decl.Variables,
2037                   Name   => Name,
2038                   Value  => New_Value);
2039                Shared.Packages.Table (Pkg).Decl.Variables := Var;
2040
2041             else
2042                Shared.Variable_Elements.Table (Var) :=
2043                  (Next   => Project.Decl.Variables,
2044                   Name   => Name,
2045                   Value  => New_Value);
2046                Project.Decl.Variables := Var;
2047             end if;
2048
2049             --  If the variable/attribute has already been declared, just
2050             --  change the value.
2051
2052          else
2053             Shared.Variable_Elements.Table (Var).Value := New_Value;
2054          end if;
2055
2056          if Is_Attribute and then Name = Snames.Name_Project_Path then
2057             if In_Tree.Is_Root_Tree then
2058                declare
2059                   Val : String_List_Id := New_Value.Values;
2060                begin
2061                   while Val /= Nil_String loop
2062                      Prj.Env.Add_Directories
2063                        (Child_Env.Project_Path,
2064                         Get_Name_String
2065                           (Shared.String_Elements.Table (Val).Value));
2066                      Val := Shared.String_Elements.Table (Val).Next;
2067                   end loop;
2068                end;
2069
2070             else
2071                if Current_Verbosity = High then
2072                   Debug_Output
2073                     ("'for Project_Path' has no effect except in"
2074                      & " root aggregate");
2075                end if;
2076             end if;
2077          end if;
2078       end Process_Expression_Variable_Decl;
2079
2080       ------------------------
2081       -- Process_Expression --
2082       ------------------------
2083
2084       procedure Process_Expression (Current : Project_Node_Id) is
2085          New_Value : Variable_Value :=
2086                        Expression
2087                          (Project                => Project,
2088                           Shared                 => Shared,
2089                           From_Project_Node      => From_Project_Node,
2090                           From_Project_Node_Tree => Node_Tree,
2091                           Env                    => Env,
2092                           Pkg                    => Pkg,
2093                           First_Term             =>
2094                             Tree.First_Term
2095                               (Expression_Of (Current, Node_Tree), Node_Tree),
2096                           Kind                 =>
2097                             Expression_Kind_Of (Current, Node_Tree));
2098
2099       begin
2100          --  Process a typed variable declaration
2101
2102          if Kind_Of (Current, Node_Tree) = N_Typed_Variable_Declaration then
2103             Check_Or_Set_Typed_Variable (New_Value, Current);
2104          end if;
2105
2106          if Kind_Of (Current, Node_Tree) /= N_Attribute_Declaration
2107            or else Associative_Array_Index_Of (Current, Node_Tree) = No_Name
2108          then
2109             Process_Expression_Variable_Decl (Current, New_Value);
2110          else
2111             Process_Expression_For_Associative_Array (Current, New_Value);
2112          end if;
2113       end Process_Expression;
2114
2115       -----------------------------------
2116       -- Process_Attribute_Declaration --
2117       -----------------------------------
2118
2119       procedure Process_Attribute_Declaration (Current : Project_Node_Id) is
2120       begin
2121          if Expression_Of (Current, Node_Tree) = Empty_Node then
2122             Process_Associative_Array (Current);
2123          else
2124             Process_Expression (Current);
2125          end if;
2126       end Process_Attribute_Declaration;
2127
2128       -------------------------------
2129       -- Process_Case_Construction --
2130       -------------------------------
2131
2132       procedure Process_Case_Construction
2133         (Current_Item : Project_Node_Id)
2134       is
2135          The_Project : Project_Id := Project;
2136          --  The id of the project of the case variable
2137
2138          The_Package : Package_Id := Pkg;
2139          --  The id of the package, if any, of the case variable
2140
2141          The_Variable : Variable_Value := Nil_Variable_Value;
2142          --  The case variable
2143
2144          Case_Value : Name_Id := No_Name;
2145          --  The case variable value
2146
2147          Case_Item     : Project_Node_Id := Empty_Node;
2148          Choice_String : Project_Node_Id := Empty_Node;
2149          Decl_Item     : Project_Node_Id := Empty_Node;
2150
2151       begin
2152          declare
2153             Variable_Node : constant Project_Node_Id :=
2154               Case_Variable_Reference_Of
2155                 (Current_Item,
2156                  Node_Tree);
2157
2158             Var_Id : Variable_Id := No_Variable;
2159             Name   : Name_Id     := No_Name;
2160
2161          begin
2162             --  If a project was specified for the case variable, get its id
2163
2164             if Present (Project_Node_Of (Variable_Node, Node_Tree)) then
2165                Name :=
2166                  Name_Of
2167                    (Project_Node_Of (Variable_Node, Node_Tree), Node_Tree);
2168                The_Project :=
2169                  Imported_Or_Extended_Project_From (Project, Name);
2170             end if;
2171
2172             --  If a package was specified for the case variable, get its id
2173
2174             if Present (Package_Node_Of (Variable_Node, Node_Tree)) then
2175                Name :=
2176                  Name_Of
2177                    (Package_Node_Of (Variable_Node, Node_Tree), Node_Tree);
2178                The_Package := Package_From (The_Project, Shared, Name);
2179             end if;
2180
2181             Name := Name_Of (Variable_Node, Node_Tree);
2182
2183             --  First, look for the case variable into the package, if any
2184
2185             if The_Package /= No_Package then
2186                Name := Name_Of (Variable_Node, Node_Tree);
2187
2188                Var_Id := Shared.Packages.Table (The_Package).Decl.Variables;
2189                while Var_Id /= No_Variable
2190                  and then Shared.Variable_Elements.Table (Var_Id).Name /= Name
2191                loop
2192                   Var_Id := Shared.Variable_Elements.Table (Var_Id).Next;
2193                end loop;
2194             end if;
2195
2196             --  If not found in the package, or if there is no package, look at
2197             --  the project level.
2198
2199             if Var_Id = No_Variable
2200               and then No (Package_Node_Of (Variable_Node, Node_Tree))
2201             then
2202                Var_Id := The_Project.Decl.Variables;
2203                while Var_Id /= No_Variable
2204                  and then Shared.Variable_Elements.Table (Var_Id).Name /= Name
2205                loop
2206                   Var_Id := Shared.Variable_Elements.Table (Var_Id).Next;
2207                end loop;
2208             end if;
2209
2210             if Var_Id = No_Variable then
2211
2212                --  Should never happen, because this has already been checked
2213                --  during parsing.
2214
2215                Write_Line
2216                  ("variable """ & Get_Name_String (Name) & """ not found");
2217                raise Program_Error;
2218             end if;
2219
2220             --  Get the case variable
2221
2222             The_Variable := Shared.Variable_Elements. Table (Var_Id).Value;
2223
2224             if The_Variable.Kind /= Single then
2225
2226                --  Should never happen, because this has already been checked
2227                --  during parsing.
2228
2229                Write_Line ("variable""" & Get_Name_String (Name) &
2230                            """ is not a single string variable");
2231                raise Program_Error;
2232             end if;
2233
2234             --  Get the case variable value
2235
2236             Case_Value := The_Variable.Value;
2237          end;
2238
2239          --  Now look into all the case items of the case construction
2240
2241          Case_Item := First_Case_Item_Of (Current_Item, Node_Tree);
2242
2243          Case_Item_Loop :
2244          while Present (Case_Item) loop
2245             Choice_String := First_Choice_Of (Case_Item, Node_Tree);
2246
2247             --  When Choice_String is nil, it means that it is the
2248             --  "when others =>" alternative.
2249
2250             if No (Choice_String) then
2251                Decl_Item := First_Declarative_Item_Of (Case_Item, Node_Tree);
2252                exit Case_Item_Loop;
2253             end if;
2254
2255             --  Look into all the alternative of this case item
2256
2257             Choice_Loop :
2258             while Present (Choice_String) loop
2259                if Case_Value = String_Value_Of (Choice_String, Node_Tree) then
2260                   Decl_Item :=
2261                     First_Declarative_Item_Of (Case_Item, Node_Tree);
2262                   exit Case_Item_Loop;
2263                end if;
2264
2265                Choice_String := Next_Literal_String (Choice_String, Node_Tree);
2266             end loop Choice_Loop;
2267
2268             Case_Item := Next_Case_Item (Case_Item, Node_Tree);
2269          end loop Case_Item_Loop;
2270
2271          --  If there is an alternative, then we process it
2272
2273          if Present (Decl_Item) then
2274             Process_Declarative_Items
2275               (Project                => Project,
2276                In_Tree                => In_Tree,
2277                From_Project_Node      => From_Project_Node,
2278                Node_Tree              => Node_Tree,
2279                Env                    => Env,
2280                Pkg                    => Pkg,
2281                Item                   => Decl_Item,
2282                Child_Env              => Child_Env);
2283          end if;
2284       end Process_Case_Construction;
2285
2286       --  Local variables
2287
2288       Current, Decl : Project_Node_Id;
2289       Kind          : Project_Node_Kind;
2290
2291    --  Start of processing for Process_Declarative_Items
2292
2293    begin
2294       Decl := Item;
2295       while Present (Decl) loop
2296          Current := Current_Item_Node (Decl, Node_Tree);
2297          Decl    := Next_Declarative_Item (Decl, Node_Tree);
2298          Kind    := Kind_Of (Current, Node_Tree);
2299
2300          case Kind is
2301             when N_Package_Declaration =>
2302                Process_Package_Declaration (Current);
2303
2304             --  Nothing to process for string type declaration
2305
2306             when N_String_Type_Declaration =>
2307                null;
2308
2309             when N_Attribute_Declaration      |
2310                  N_Typed_Variable_Declaration |
2311                  N_Variable_Declaration       =>
2312                Process_Attribute_Declaration (Current);
2313
2314             when N_Case_Construction =>
2315                Process_Case_Construction (Current);
2316
2317             when others =>
2318                Write_Line ("Illegal declarative item: " & Kind'Img);
2319                raise Program_Error;
2320          end case;
2321       end loop;
2322    end Process_Declarative_Items;
2323
2324    ----------------------------------
2325    -- Process_Project_Tree_Phase_1 --
2326    ----------------------------------
2327
2328    procedure Process_Project_Tree_Phase_1
2329      (In_Tree                : Project_Tree_Ref;
2330       Project                : out Project_Id;
2331       Packages_To_Check      : String_List_Access;
2332       Success                : out Boolean;
2333       From_Project_Node      : Project_Node_Id;
2334       From_Project_Node_Tree : Project_Node_Tree_Ref;
2335       Env                    : in out Prj.Tree.Environment;
2336       Reset_Tree             : Boolean := True)
2337    is
2338    begin
2339       if Reset_Tree then
2340
2341          --  Make sure there are no projects in the data structure
2342
2343          Free_List (In_Tree.Projects, Free_Project => True);
2344       end if;
2345
2346       Processed_Projects.Reset;
2347
2348       --  And process the main project and all of the projects it depends on,
2349       --  recursively.
2350
2351       Debug_Increase_Indent ("Process tree, phase 1");
2352
2353       Recursive_Process
2354         (Project                => Project,
2355          In_Tree                => In_Tree,
2356          Packages_To_Check      => Packages_To_Check,
2357          From_Project_Node      => From_Project_Node,
2358          From_Project_Node_Tree => From_Project_Node_Tree,
2359          Env                    => Env,
2360          Extended_By            => No_Project);
2361
2362       Success :=
2363         Total_Errors_Detected = 0
2364           and then
2365           (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
2366
2367       if Current_Verbosity = High then
2368          Debug_Decrease_Indent
2369            ("Done Process tree, phase 1, Success=" & Success'Img);
2370       end if;
2371    end Process_Project_Tree_Phase_1;
2372
2373    ----------------------------------
2374    -- Process_Project_Tree_Phase_2 --
2375    ----------------------------------
2376
2377    procedure Process_Project_Tree_Phase_2
2378      (In_Tree                : Project_Tree_Ref;
2379       Project                : Project_Id;
2380       Success                : out Boolean;
2381       From_Project_Node      : Project_Node_Id;
2382       From_Project_Node_Tree : Project_Node_Tree_Ref;
2383       Env                    : Environment)
2384    is
2385       Obj_Dir    : Path_Name_Type;
2386       Extending  : Project_Id;
2387       Extending2 : Project_Id;
2388       Prj        : Project_List;
2389
2390    --  Start of processing for Process_Project_Tree_Phase_2
2391
2392    begin
2393       Success := True;
2394
2395       Debug_Increase_Indent ("Process tree, phase 2", Project.Name);
2396
2397       if Project /= No_Project then
2398          Check (In_Tree, Project, From_Project_Node_Tree, Env.Flags);
2399       end if;
2400
2401       --  If main project is an extending all project, set object directory of
2402       --  all virtual extending projects to object directory of main project.
2403
2404       if Project /= No_Project
2405         and then Is_Extending_All (From_Project_Node, From_Project_Node_Tree)
2406       then
2407          declare
2408             Object_Dir : constant Path_Information := Project.Object_Directory;
2409
2410          begin
2411             Prj := In_Tree.Projects;
2412             while Prj /= null loop
2413                if Prj.Project.Virtual then
2414                   Prj.Project.Object_Directory := Object_Dir;
2415                end if;
2416
2417                Prj := Prj.Next;
2418             end loop;
2419          end;
2420       end if;
2421
2422       --  Check that no extending project shares its object directory with
2423       --  the project(s) it extends.
2424
2425       if Project /= No_Project then
2426          Prj := In_Tree.Projects;
2427          while Prj /= null loop
2428             Extending := Prj.Project.Extended_By;
2429
2430             if Extending /= No_Project then
2431                Obj_Dir := Prj.Project.Object_Directory.Name;
2432
2433                --  Check that a project being extended does not share its
2434                --  object directory with any project that extends it, directly
2435                --  or indirectly, including a virtual extending project.
2436
2437                --  Start with the project directly extending it
2438
2439                Extending2 := Extending;
2440                while Extending2 /= No_Project loop
2441                   if Has_Ada_Sources (Extending2)
2442                     and then Extending2.Object_Directory.Name = Obj_Dir
2443                   then
2444                      if Extending2.Virtual then
2445                         Error_Msg_Name_1 := Prj.Project.Display_Name;
2446                         Error_Msg
2447                           (Env.Flags,
2448                            "project %% cannot be extended by a virtual" &
2449                            " project with the same object directory",
2450                            Prj.Project.Location, Project);
2451
2452                      else
2453                         Error_Msg_Name_1 := Extending2.Display_Name;
2454                         Error_Msg_Name_2 := Prj.Project.Display_Name;
2455                         Error_Msg
2456                           (Env.Flags,
2457                            "project %% cannot extend project %%",
2458                            Extending2.Location, Project);
2459                         Error_Msg
2460                           (Env.Flags,
2461                            "\they share the same object directory",
2462                            Extending2.Location, Project);
2463                      end if;
2464                   end if;
2465
2466                   --  Continue with the next extending project, if any
2467
2468                   Extending2 := Extending2.Extended_By;
2469                end loop;
2470             end if;
2471
2472             Prj := Prj.Next;
2473          end loop;
2474       end if;
2475
2476       Debug_Decrease_Indent ("Done Process tree, phase 2");
2477
2478       Success := Total_Errors_Detected = 0
2479         and then
2480           (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
2481    end Process_Project_Tree_Phase_2;
2482
2483    -----------------------
2484    -- Recursive_Process --
2485    -----------------------
2486
2487    procedure Recursive_Process
2488      (In_Tree                : Project_Tree_Ref;
2489       Project                : out Project_Id;
2490       Packages_To_Check      : String_List_Access;
2491       From_Project_Node      : Project_Node_Id;
2492       From_Project_Node_Tree : Project_Node_Tree_Ref;
2493       Env                    : in out Prj.Tree.Environment;
2494       Extended_By            : Project_Id)
2495    is
2496       Shared : constant Shared_Project_Tree_Data_Access := In_Tree.Shared;
2497
2498       Child_Env              : Prj.Tree.Environment;
2499       --  Only used for the root aggregate project (if any). This is left
2500       --  uninitialized otherwise.
2501
2502       procedure Process_Imported_Projects
2503         (Imported     : in out Project_List;
2504          Limited_With : Boolean);
2505       --  Process imported projects. If Limited_With is True, then only
2506       --  projects processed through a "limited with" are processed, otherwise
2507       --  only projects imported through a standard "with" are processed.
2508       --  Imported is the id of the last imported project.
2509
2510       procedure Process_Aggregated_Projects;
2511       --  Process all the projects aggregated in List. This does nothing if the
2512       --  project is not an aggregate project.
2513
2514       procedure Process_Extended_Project;
2515       --  Process the extended project: inherit all packages from the extended
2516       --  project that are not explicitly defined or renamed. Also inherit the
2517       --  languages, if attribute Languages is not explicitly defined.
2518
2519       -------------------------------
2520       -- Process_Imported_Projects --
2521       -------------------------------
2522
2523       procedure Process_Imported_Projects
2524         (Imported     : in out Project_List;
2525          Limited_With : Boolean)
2526       is
2527          With_Clause : Project_Node_Id;
2528          New_Project : Project_Id;
2529          Proj_Node   : Project_Node_Id;
2530
2531       begin
2532          With_Clause :=
2533            First_With_Clause_Of
2534              (From_Project_Node, From_Project_Node_Tree);
2535
2536          while Present (With_Clause) loop
2537             Proj_Node :=
2538               Non_Limited_Project_Node_Of
2539                 (With_Clause, From_Project_Node_Tree);
2540             New_Project := No_Project;
2541
2542             if (Limited_With and then No (Proj_Node))
2543               or else (not Limited_With and then Present (Proj_Node))
2544             then
2545                Recursive_Process
2546                  (In_Tree                => In_Tree,
2547                   Project                => New_Project,
2548                   Packages_To_Check      => Packages_To_Check,
2549                   From_Project_Node      =>
2550                     Project_Node_Of (With_Clause, From_Project_Node_Tree),
2551                   From_Project_Node_Tree => From_Project_Node_Tree,
2552                   Env                    => Env,
2553                   Extended_By            => No_Project);
2554
2555                --  Imported is the id of the last imported project. If
2556                --  it is nil, then this imported project is our first.
2557
2558                if Imported = null then
2559                   Project.Imported_Projects :=
2560                     new Project_List_Element'
2561                       (Project => New_Project,
2562                        Next    => null);
2563                   Imported := Project.Imported_Projects;
2564                else
2565                   Imported.Next := new Project_List_Element'
2566                     (Project => New_Project,
2567                      Next    => null);
2568                   Imported := Imported.Next;
2569                end if;
2570             end if;
2571
2572             With_Clause :=
2573               Next_With_Clause_Of (With_Clause, From_Project_Node_Tree);
2574          end loop;
2575       end Process_Imported_Projects;
2576
2577       ---------------------------------
2578       -- Process_Aggregated_Projects --
2579       ---------------------------------
2580
2581       procedure Process_Aggregated_Projects is
2582          List           : Aggregated_Project_List;
2583          Loaded_Project : Prj.Tree.Project_Node_Id;
2584          Success        : Boolean := True;
2585          Tree           : Project_Tree_Ref;
2586
2587       begin
2588          if Project.Qualifier not in Aggregate_Project then
2589             return;
2590          end if;
2591
2592          Debug_Increase_Indent ("Process_Aggregated_Projects", Project.Name);
2593
2594          Prj.Nmsc.Process_Aggregated_Projects
2595            (Tree      => In_Tree,
2596             Project   => Project,
2597             Node_Tree => From_Project_Node_Tree,
2598             Flags     => Env.Flags);
2599
2600          List := Project.Aggregated_Projects;
2601          while Success and then List /= null loop
2602             Prj.Part.Parse
2603               (In_Tree           => From_Project_Node_Tree,
2604                Project           => Loaded_Project,
2605                Packages_To_Check => Packages_To_Check,
2606                Project_File_Name => Get_Name_String (List.Path),
2607                Errout_Handling   => Prj.Part.Never_Finalize,
2608                Current_Directory => Get_Name_String (Project.Directory.Name),
2609                Is_Config_File    => False,
2610                Env               => Child_Env);
2611
2612             Success := not Prj.Tree.No (Loaded_Project);
2613
2614             if Success then
2615                List.Tree := new Project_Tree_Data (Is_Root_Tree => False);
2616                Prj.Initialize (List.Tree);
2617                List.Tree.Shared := In_Tree.Shared;
2618
2619                --  In aggregate library, aggregated projects are parsed using
2620                --  the aggregate library tree.
2621
2622                if Project.Qualifier = Aggregate_Library then
2623                   Tree := In_Tree;
2624                else
2625                   Tree := List.Tree;
2626                end if;
2627
2628                --  We can only do the phase 1 of the processing, since we do
2629                --  not have access to the configuration file yet (this is
2630                --  called when doing phase 1 of the processing for the root
2631                --  aggregate project).
2632
2633                if In_Tree.Is_Root_Tree then
2634                   Process_Project_Tree_Phase_1
2635                     (In_Tree                => Tree,
2636                      Project                => List.Project,
2637                      Packages_To_Check      => Packages_To_Check,
2638                      Success                => Success,
2639                      From_Project_Node      => Loaded_Project,
2640                      From_Project_Node_Tree => From_Project_Node_Tree,
2641                      Env                    => Child_Env,
2642                      Reset_Tree             => False);
2643                else
2644                   --  use the same environment as the rest of the aggregated
2645                   --  projects, ie the one that was setup by the root aggregate
2646                   Process_Project_Tree_Phase_1
2647                     (In_Tree                => Tree,
2648                      Project                => List.Project,
2649                      Packages_To_Check      => Packages_To_Check,
2650                      Success                => Success,
2651                      From_Project_Node      => Loaded_Project,
2652                      From_Project_Node_Tree => From_Project_Node_Tree,
2653                      Env                    => Env,
2654                      Reset_Tree             => False);
2655                end if;
2656
2657             else
2658                Debug_Output ("Failed to parse", Name_Id (List.Path));
2659             end if;
2660
2661             List := List.Next;
2662          end loop;
2663
2664          Debug_Decrease_Indent ("Done Process_Aggregated_Projects");
2665       end Process_Aggregated_Projects;
2666
2667       ------------------------------
2668       -- Process_Extended_Project --
2669       ------------------------------
2670
2671       procedure Process_Extended_Project is
2672          Extended_Pkg : Package_Id;
2673          Current_Pkg  : Package_Id;
2674          Element      : Package_Element;
2675          First        : constant Package_Id := Project.Decl.Packages;
2676          Attribute1   : Variable_Id;
2677          Attribute2   : Variable_Id;
2678          Attr_Value1  : Variable;
2679          Attr_Value2  : Variable;
2680
2681       begin
2682          Extended_Pkg := Project.Extends.Decl.Packages;
2683          while Extended_Pkg /= No_Package loop
2684             Element := Shared.Packages.Table (Extended_Pkg);
2685
2686             Current_Pkg := First;
2687             while Current_Pkg /= No_Package
2688               and then
2689                 Shared.Packages.Table (Current_Pkg).Name /= Element.Name
2690             loop
2691                Current_Pkg := Shared.Packages.Table (Current_Pkg).Next;
2692             end loop;
2693
2694             if Current_Pkg = No_Package then
2695                Package_Table.Increment_Last (Shared.Packages);
2696                Current_Pkg := Package_Table.Last (Shared.Packages);
2697                Shared.Packages.Table (Current_Pkg) :=
2698                  (Name   => Element.Name,
2699                   Decl   => No_Declarations,
2700                   Parent => No_Package,
2701                   Next   => Project.Decl.Packages);
2702                Project.Decl.Packages := Current_Pkg;
2703                Copy_Package_Declarations
2704                  (From       => Element.Decl,
2705                   To         => Shared.Packages.Table (Current_Pkg).Decl,
2706                   New_Loc    => No_Location,
2707                   Restricted => True,
2708                   Shared     => Shared);
2709             end if;
2710
2711             Extended_Pkg := Element.Next;
2712          end loop;
2713
2714          --  Check if attribute Languages is declared in the extending project
2715
2716          Attribute1 := Project.Decl.Attributes;
2717          while Attribute1 /= No_Variable loop
2718             Attr_Value1 := Shared.Variable_Elements. Table (Attribute1);
2719             exit when Attr_Value1.Name = Snames.Name_Languages;
2720             Attribute1 := Attr_Value1.Next;
2721          end loop;
2722
2723          if Attribute1 = No_Variable or else Attr_Value1.Value.Default then
2724
2725             --  Attribute Languages is not declared in the extending project.
2726             --  Check if it is declared in the project being extended.
2727
2728             Attribute2 := Project.Extends.Decl.Attributes;
2729             while Attribute2 /= No_Variable loop
2730                Attr_Value2 := Shared.Variable_Elements.Table (Attribute2);
2731                exit when Attr_Value2.Name = Snames.Name_Languages;
2732                Attribute2 := Attr_Value2.Next;
2733             end loop;
2734
2735             if Attribute2 /= No_Variable
2736               and then not Attr_Value2.Value.Default
2737             then
2738                --  As attribute Languages is declared in the project being
2739                --  extended, copy its value for the extending project.
2740
2741                if Attribute1 = No_Variable then
2742                   Variable_Element_Table.Increment_Last
2743                     (Shared.Variable_Elements);
2744                   Attribute1 := Variable_Element_Table.Last
2745                     (Shared.Variable_Elements);
2746                   Attr_Value1.Next := Project.Decl.Attributes;
2747                   Project.Decl.Attributes := Attribute1;
2748                end if;
2749
2750                Attr_Value1.Name := Snames.Name_Languages;
2751                Attr_Value1.Value := Attr_Value2.Value;
2752                Shared.Variable_Elements.Table (Attribute1) := Attr_Value1;
2753             end if;
2754          end if;
2755       end Process_Extended_Project;
2756
2757    --  Start of processing for Recursive_Process
2758
2759    begin
2760       if No (From_Project_Node) then
2761          Project := No_Project;
2762
2763       else
2764          declare
2765             Imported         : Project_List;
2766             Declaration_Node : Project_Node_Id  := Empty_Node;
2767
2768             Name : constant Name_Id :=
2769                      Name_Of (From_Project_Node, From_Project_Node_Tree);
2770
2771             Name_Node : constant Tree_Private_Part.Project_Name_And_Node :=
2772                           Tree_Private_Part.Projects_Htable.Get
2773                             (From_Project_Node_Tree.Projects_HT, Name);
2774
2775          begin
2776             Project := Processed_Projects.Get (Name);
2777
2778             if Project /= No_Project then
2779
2780                --  Make sure that, when a project is extended, the project id
2781                --  of the project extending it is recorded in its data, even
2782                --  when it has already been processed as an imported project.
2783                --  This is for virtually extended projects.
2784
2785                if Extended_By /= No_Project then
2786                   Project.Extended_By := Extended_By;
2787                end if;
2788
2789                return;
2790             end if;
2791
2792             Project :=
2793               new Project_Data'
2794                 (Empty_Project
2795                   (Project_Qualifier_Of
2796                     (From_Project_Node, From_Project_Node_Tree)));
2797
2798             In_Tree.Projects :=
2799               new Project_List_Element'
2800                     (Project => Project,
2801                      Next    => In_Tree.Projects);
2802
2803             Processed_Projects.Set (Name, Project);
2804
2805             Project.Name := Name;
2806             Project.Display_Name := Name_Node.Display_Name;
2807             Get_Name_String (Name);
2808
2809             --  If name starts with the virtual prefix, flag the project as
2810             --  being a virtual extending project.
2811
2812             if Name_Len > Virtual_Prefix'Length
2813               and then
2814                 Name_Buffer (1 .. Virtual_Prefix'Length) = Virtual_Prefix
2815             then
2816                Project.Virtual := True;
2817             end if;
2818
2819             Project.Path.Display_Name :=
2820               Path_Name_Of (From_Project_Node, From_Project_Node_Tree);
2821             Get_Name_String (Project.Path.Display_Name);
2822             Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2823             Project.Path.Name := Name_Find;
2824
2825             Project.Location :=
2826               Location_Of (From_Project_Node, From_Project_Node_Tree);
2827
2828             Project.Directory.Display_Name :=
2829               Directory_Of (From_Project_Node, From_Project_Node_Tree);
2830             Get_Name_String (Project.Directory.Display_Name);
2831             Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2832             Project.Directory.Name := Name_Find;
2833
2834             Project.Extended_By := Extended_By;
2835
2836             Add_Attributes
2837               (Project,
2838                Name,
2839                Name_Id (Project.Directory.Name),
2840                In_Tree.Shared,
2841                Project.Decl,
2842                Prj.Attr.Attribute_First,
2843                Project_Level => True);
2844
2845             Process_Imported_Projects (Imported, Limited_With => False);
2846
2847             if Project.Qualifier = Aggregate and then In_Tree.Is_Root_Tree then
2848                Initialize_And_Copy (Child_Env, Copy_From => Env);
2849
2850             elsif Project.Qualifier = Aggregate_Library then
2851
2852                --  The child environment is the same as the current one
2853
2854                Child_Env := Env;
2855
2856             else
2857                --  No need to initialize Child_Env, since it will not be
2858                --  used anyway by Process_Declarative_Items (only the root
2859                --  aggregate can modify it, and it is never read anyway).
2860
2861                null;
2862             end if;
2863
2864             Declaration_Node :=
2865               Project_Declaration_Of
2866                 (From_Project_Node, From_Project_Node_Tree);
2867
2868             Recursive_Process
2869               (In_Tree                => In_Tree,
2870                Project                => Project.Extends,
2871                Packages_To_Check      => Packages_To_Check,
2872                From_Project_Node      =>
2873                  Extended_Project_Of
2874                    (Declaration_Node, From_Project_Node_Tree),
2875                From_Project_Node_Tree => From_Project_Node_Tree,
2876                Env                    => Env,
2877                Extended_By            => Project);
2878
2879             Process_Declarative_Items
2880               (Project                => Project,
2881                In_Tree                => In_Tree,
2882                From_Project_Node      => From_Project_Node,
2883                Node_Tree              => From_Project_Node_Tree,
2884                Env                    => Env,
2885                Pkg                    => No_Package,
2886                Item                   => First_Declarative_Item_Of
2887                  (Declaration_Node, From_Project_Node_Tree),
2888                Child_Env              => Child_Env);
2889
2890             if Project.Extends /= No_Project then
2891                Process_Extended_Project;
2892             end if;
2893
2894             Process_Imported_Projects (Imported, Limited_With => True);
2895
2896             if Err_Vars.Total_Errors_Detected = 0 then
2897                Process_Aggregated_Projects;
2898
2899                --  For an aggregate library we add the aggregated projects as
2900                --  imported ones. This is necessary to give visibility to all
2901                --  sources from the aggregates from the aggregated library
2902                --  projects.
2903
2904                if Project.Qualifier = Aggregate_Library then
2905                   declare
2906                      L : Aggregated_Project_List;
2907                   begin
2908                      L := Project.Aggregated_Projects;
2909                      while L /= null loop
2910                         Project.Imported_Projects :=
2911                           new Project_List_Element'
2912                             (Project => L.Project,
2913                              Next    => Project.Imported_Projects);
2914                         L := L.Next;
2915                      end loop;
2916                   end;
2917                end if;
2918             end if;
2919
2920             if Project.Qualifier = Aggregate and then In_Tree.Is_Root_Tree then
2921                Free (Child_Env);
2922             end if;
2923          end;
2924       end if;
2925    end Recursive_Process;
2926
2927 end Prj.Proc;