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