gcc/ada/prj-proc.adb

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