gcc/ada/prj-proc.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              P R J . P R O C                             --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2001-2008, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Err_Vars; use Err_Vars;
  27 with Opt;      use Opt;
  28 with Osint;    use Osint;
  29 with Output;   use Output;
  30 with Prj.Attr; use Prj.Attr;
  31 with Prj.Err;  use Prj.Err;
  32 with Prj.Ext;  use Prj.Ext;
  33 with Prj.Nmsc; use Prj.Nmsc;
  34 with Sinput;   use Sinput;
  35 with Snames;
  36
  37 with GNAT.Case_Util; use GNAT.Case_Util;
  38 with GNAT.HTable;
  39
  40 package body Prj.Proc is
  41
  42    Error_Report : Put_Line_Access := null;
  43
  44    package Processed_Projects is new GNAT.HTable.Simple_HTable
  45      (Header_Num => Header_Num,
  46       Element    => Project_Id,
  47       No_Element => No_Project,
  48       Key        => Name_Id,
  49       Hash       => Hash,
  50       Equal      => "=");
  51    --  This hash table contains all processed projects
  52
  53    package Unit_Htable is new GNAT.HTable.Simple_HTable
  54      (Header_Num => Header_Num,
  55       Element    => Source_Id,
  56       No_Element => No_Source,
  57       Key        => Name_Id,
  58       Hash       => Hash,
  59       Equal      => "=");
  60    --  This hash table contains all processed projects
  61
  62    procedure Add (To_Exp : in out Name_Id; Str : Name_Id);
  63    --  Concatenate two strings and returns another string if both
  64    --  arguments are not null string.
  65
  66    procedure Add_Attributes
  67      (Project       : Project_Id;
  68       Project_Name  : Name_Id;
  69       In_Tree       : Project_Tree_Ref;
  70       Decl          : in out Declarations;
  71       First         : Attribute_Node_Id;
  72       Project_Level : Boolean);
  73    --  Add all attributes, starting with First, with their default
  74    --  values to the package or project with declarations Decl.
  75
  76    procedure Check
  77      (In_Tree         : Project_Tree_Ref;
  78       Project         : Project_Id;
  79       Current_Dir     : String;
  80       When_No_Sources : Error_Warning);
  81    --  Set all projects to not checked, then call Recursive_Check for the
  82    --  main project Project. Project is set to No_Project if errors occurred.
  83    --  Current_Dir is for optimization purposes, avoiding extra system calls.
  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       Current_Dir     : String;
 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    --  Current_Dir is for optimization purposes, avoiding extra system calls.
 149
 150    ---------
 151    -- Add --
 152    ---------
 153
 154    procedure Add (To_Exp : in out Name_Id; Str : Name_Id) is
 155    begin
 156       if To_Exp = No_Name or else To_Exp = Empty_String then
 157
 158          --  To_Exp is nil or empty. The result is Str
 159
 160          To_Exp := Str;
 161
 162       --  If Str is nil, then do not change To_Ext
 163
 164       elsif Str /= No_Name and then Str /= Empty_String then
 165          declare
 166             S : constant String := Get_Name_String (Str);
 167
 168          begin
 169             Get_Name_String (To_Exp);
 170             Add_Str_To_Name_Buffer (S);
 171             To_Exp := Name_Find;
 172          end;
 173       end if;
 174    end Add;
 175
 176    --------------------
 177    -- Add_Attributes --
 178    --------------------
 179
 180    procedure Add_Attributes
 181      (Project       : Project_Id;
 182       Project_Name  : Name_Id;
 183       In_Tree       : Project_Tree_Ref;
 184       Decl          : in out Declarations;
 185       First         : Attribute_Node_Id;
 186       Project_Level : Boolean)
 187    is
 188       The_Attribute  : Attribute_Node_Id := First;
 189
 190    begin
 191       while The_Attribute /= Empty_Attribute loop
 192          if Attribute_Kind_Of (The_Attribute) = Single then
 193             declare
 194                New_Attribute : Variable_Value;
 195
 196             begin
 197                case Variable_Kind_Of (The_Attribute) is
 198
 199                   --  Undefined should not happen
 200
 201                   when Undefined =>
 202                      pragma Assert
 203                        (False, "attribute with an undefined kind");
 204                      raise Program_Error;
 205
 206                   --  Single attributes have a default value of empty string
 207
 208                   when Single =>
 209                      New_Attribute :=
 210                        (Project  => Project,
 211                         Kind     => Single,
 212                         Location => No_Location,
 213                         Default  => True,
 214                         Value    => Empty_String,
 215                         Index    => 0);
 216
 217                      --  Special case of <project>'Name
 218
 219                      if Project_Level
 220                        and then Attribute_Name_Of (The_Attribute) =
 221                                   Snames.Name_Name
 222                      then
 223                         New_Attribute.Value := Project_Name;
 224                      end if;
 225
 226                   --  List attributes have a default value of nil list
 227
 228                   when List =>
 229                      New_Attribute :=
 230                        (Project  => Project,
 231                         Kind     => List,
 232                         Location => No_Location,
 233                         Default  => True,
 234                         Values   => Nil_String);
 235
 236                end case;
 237
 238                Variable_Element_Table.Increment_Last
 239                  (In_Tree.Variable_Elements);
 240                In_Tree.Variable_Elements.Table
 241                  (Variable_Element_Table.Last
 242                    (In_Tree.Variable_Elements)) :=
 243                  (Next  => Decl.Attributes,
 244                   Name  => Attribute_Name_Of (The_Attribute),
 245                   Value => New_Attribute);
 246                Decl.Attributes := Variable_Element_Table.Last
 247                  (In_Tree.Variable_Elements);
 248             end;
 249          end if;
 250
 251          The_Attribute := Next_Attribute (After => The_Attribute);
 252       end loop;
 253    end Add_Attributes;
 254
 255    -----------
 256    -- Check --
 257    -----------
 258
 259    procedure Check
 260      (In_Tree         : Project_Tree_Ref;
 261       Project         : Project_Id;
 262       Current_Dir     : String;
 263       When_No_Sources : Error_Warning)
 264    is
 265    begin
 266       --  Make sure that all projects are marked as not checked
 267
 268       for Index in Project_Table.First ..
 269                    Project_Table.Last (In_Tree.Projects)
 270       loop
 271          In_Tree.Projects.Table (Index).Checked := False;
 272       end loop;
 273
 274       Recursive_Check (Project, In_Tree, Current_Dir, 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 := In_Tree.Projects.Table (Project);
1107       List        : Project_List;
1108       Result      : Project_Id;
1109       Temp_Result : Project_Id;
1110
1111    begin
1112       --  First check if it is the name of an extended project
1113
1114       Result := Data.Extends;
1115       while Result /= No_Project loop
1116          if In_Tree.Projects.Table (Result).Name = With_Name then
1117             return Result;
1118          else
1119             Result := In_Tree.Projects.Table (Result).Extends;
1120          end if;
1121       end loop;
1122
1123       --  Then check the name of each imported project
1124
1125       Temp_Result := No_Project;
1126       List := Data.Imported_Projects;
1127       while List /= Empty_Project_List loop
1128          Result := In_Tree.Project_Lists.Table (List).Project;
1129
1130          --  If the project is directly imported, then returns its ID
1131
1132          if In_Tree.Projects.Table (Result).Name = With_Name then
1133             return Result;
1134          end if;
1135
1136          --  If a project extending the project is imported, then keep this
1137          --  extending project as a possibility. It will be the returned ID
1138          --  if the project is not imported directly.
1139
1140          declare
1141             Proj : Project_Id := In_Tree.Projects.Table (Result).Extends;
1142
1143          begin
1144             while Proj /= No_Project loop
1145                if In_Tree.Projects.Table (Proj).Name = With_Name then
1146                   Temp_Result := Result;
1147                   exit;
1148                end if;
1149
1150                Proj := In_Tree.Projects.Table (Proj).Extends;
1151             end loop;
1152          end;
1153
1154          List := In_Tree.Project_Lists.Table (List).Next;
1155       end loop;
1156
1157       pragma Assert (Temp_Result /= No_Project, "project not found");
1158       return Temp_Result;
1159    end Imported_Or_Extended_Project_From;
1160
1161    ------------------
1162    -- Package_From --
1163    ------------------
1164
1165    function Package_From
1166      (Project   : Project_Id;
1167       In_Tree   : Project_Tree_Ref;
1168       With_Name : Name_Id) return Package_Id
1169    is
1170       Data   : constant Project_Data :=
1171         In_Tree.Projects.Table (Project);
1172       Result : Package_Id := Data.Decl.Packages;
1173
1174    begin
1175       --  Check the name of each existing package of Project
1176
1177       while Result /= No_Package
1178         and then In_Tree.Packages.Table (Result).Name /= With_Name
1179       loop
1180          Result := In_Tree.Packages.Table (Result).Next;
1181       end loop;
1182
1183       if Result = No_Package then
1184
1185          --  Should never happen
1186
1187          Write_Line ("package """ & Get_Name_String (With_Name) &
1188                      """ not found");
1189          raise Program_Error;
1190
1191       else
1192          return Result;
1193       end if;
1194    end Package_From;
1195
1196    -------------
1197    -- Process --
1198    -------------
1199
1200    procedure Process
1201      (In_Tree                : Project_Tree_Ref;
1202       Project                : out Project_Id;
1203       Success                : out Boolean;
1204       From_Project_Node      : Project_Node_Id;
1205       From_Project_Node_Tree : Project_Node_Tree_Ref;
1206       Report_Error           : Put_Line_Access;
1207       When_No_Sources        : Error_Warning := Error;
1208       Reset_Tree             : Boolean := True;
1209       Current_Dir            : String := "")
1210    is
1211    begin
1212       Process_Project_Tree_Phase_1
1213         (In_Tree                => In_Tree,
1214          Project                => Project,
1215          Success                => Success,
1216          From_Project_Node      => From_Project_Node,
1217          From_Project_Node_Tree => From_Project_Node_Tree,
1218          Report_Error           => Report_Error,
1219          Reset_Tree             => Reset_Tree);
1220
1221       if not In_Configuration then
1222          Process_Project_Tree_Phase_2
1223            (In_Tree                => In_Tree,
1224             Project                => Project,
1225             Success                => Success,
1226             From_Project_Node      => From_Project_Node,
1227             From_Project_Node_Tree => From_Project_Node_Tree,
1228             Report_Error           => Report_Error,
1229             When_No_Sources        => When_No_Sources,
1230             Current_Dir            => Current_Dir);
1231       end if;
1232    end Process;
1233
1234    -------------------------------
1235    -- Process_Declarative_Items --
1236    -------------------------------
1237
1238    procedure Process_Declarative_Items
1239      (Project                : Project_Id;
1240       In_Tree                : Project_Tree_Ref;
1241       From_Project_Node      : Project_Node_Id;
1242       From_Project_Node_Tree : Project_Node_Tree_Ref;
1243       Pkg                    : Package_Id;
1244       Item                   : Project_Node_Id)
1245    is
1246       Current_Declarative_Item : Project_Node_Id;
1247       Current_Item             : Project_Node_Id;
1248
1249    begin
1250       --  Loop through declarative items
1251
1252       Current_Item := Empty_Node;
1253
1254       Current_Declarative_Item := Item;
1255       while Current_Declarative_Item /= Empty_Node loop
1256
1257          --  Get its data
1258
1259          Current_Item :=
1260            Current_Item_Node
1261              (Current_Declarative_Item, From_Project_Node_Tree);
1262
1263          --  And set Current_Declarative_Item to the next declarative item
1264          --  ready for the next iteration.
1265
1266          Current_Declarative_Item :=
1267            Next_Declarative_Item
1268              (Current_Declarative_Item, From_Project_Node_Tree);
1269
1270          case Kind_Of (Current_Item, From_Project_Node_Tree) is
1271
1272             when N_Package_Declaration =>
1273
1274                --  Do not process a package declaration that should be ignored
1275
1276                if Expression_Kind_Of
1277                     (Current_Item, From_Project_Node_Tree) /= Ignored
1278                then
1279                   --  Create the new package
1280
1281                   Package_Table.Increment_Last (In_Tree.Packages);
1282
1283                   declare
1284                      New_Pkg         : constant Package_Id :=
1285                                          Package_Table.Last (In_Tree.Packages);
1286                      The_New_Package : Package_Element;
1287
1288                      Project_Of_Renamed_Package :
1289                        constant Project_Node_Id :=
1290                          Project_Of_Renamed_Package_Of
1291                            (Current_Item, From_Project_Node_Tree);
1292
1293                   begin
1294                      --  Set the name of the new package
1295
1296                      The_New_Package.Name :=
1297                        Name_Of (Current_Item, From_Project_Node_Tree);
1298
1299                      --  Insert the new package in the appropriate list
1300
1301                      if Pkg /= No_Package then
1302                         The_New_Package.Next :=
1303                           In_Tree.Packages.Table (Pkg).Decl.Packages;
1304                         In_Tree.Packages.Table (Pkg).Decl.Packages :=
1305                           New_Pkg;
1306
1307                      else
1308                         The_New_Package.Next :=
1309                           In_Tree.Projects.Table (Project).Decl.Packages;
1310                         In_Tree.Projects.Table (Project).Decl.Packages :=
1311                           New_Pkg;
1312                      end if;
1313
1314                      In_Tree.Packages.Table (New_Pkg) :=
1315                        The_New_Package;
1316
1317                      if Project_Of_Renamed_Package /= Empty_Node then
1318
1319                         --  Renamed package
1320
1321                         declare
1322                            Project_Name : constant Name_Id :=
1323                                             Name_Of
1324                                               (Project_Of_Renamed_Package,
1325                                                From_Project_Node_Tree);
1326
1327                            Renamed_Project :
1328                              constant Project_Id :=
1329                                Imported_Or_Extended_Project_From
1330                                (Project, In_Tree, Project_Name);
1331
1332                            Renamed_Package : constant Package_Id :=
1333                                                Package_From
1334                                                  (Renamed_Project, In_Tree,
1335                                                   Name_Of
1336                                                     (Current_Item,
1337                                                      From_Project_Node_Tree));
1338
1339                         begin
1340                            --  For a renamed package, copy the declarations of
1341                            --  the renamed package, but set all the locations
1342                            --  to the location of the package name in the
1343                            --  renaming declaration.
1344
1345                            Copy_Package_Declarations
1346                              (From     =>
1347                                 In_Tree.Packages.Table (Renamed_Package).Decl,
1348                               To      =>
1349                                 In_Tree.Packages.Table (New_Pkg).Decl,
1350                               New_Loc =>
1351                                 Location_Of
1352                                   (Current_Item, From_Project_Node_Tree),
1353                               In_Tree => In_Tree);
1354                         end;
1355
1356                      --  Standard package declaration, not renaming
1357
1358                      else
1359                         --  Set the default values of the attributes
1360
1361                         Add_Attributes
1362                           (Project,
1363                            In_Tree.Projects.Table (Project).Name,
1364                            In_Tree,
1365                            In_Tree.Packages.Table (New_Pkg).Decl,
1366                            First_Attribute_Of
1367                              (Package_Id_Of
1368                                 (Current_Item, From_Project_Node_Tree)),
1369                            Project_Level => False);
1370
1371                         --  And process declarative items of the new package
1372
1373                         Process_Declarative_Items
1374                           (Project                => Project,
1375                            In_Tree                => In_Tree,
1376                            From_Project_Node      => From_Project_Node,
1377                            From_Project_Node_Tree => From_Project_Node_Tree,
1378                            Pkg                    => New_Pkg,
1379                            Item                   =>
1380                              First_Declarative_Item_Of
1381                                (Current_Item, From_Project_Node_Tree));
1382                      end if;
1383                   end;
1384                end if;
1385
1386             when N_String_Type_Declaration =>
1387
1388                --  There is nothing to process
1389
1390                null;
1391
1392             when N_Attribute_Declaration      |
1393                  N_Typed_Variable_Declaration |
1394                  N_Variable_Declaration       =>
1395
1396                if Expression_Of (Current_Item, From_Project_Node_Tree) =
1397                                                                   Empty_Node
1398                then
1399
1400                   --  It must be a full associative array attribute declaration
1401
1402                   declare
1403                      Current_Item_Name : constant Name_Id :=
1404                                            Name_Of
1405                                              (Current_Item,
1406                                               From_Project_Node_Tree);
1407                      --  The name of the attribute
1408
1409                      New_Array : Array_Id;
1410                      --  The new associative array created
1411
1412                      Orig_Array : Array_Id;
1413                      --  The associative array value
1414
1415                      Orig_Project_Name : Name_Id := No_Name;
1416                      --  The name of the project where the associative array
1417                      --  value is.
1418
1419                      Orig_Project : Project_Id := No_Project;
1420                      --  The id of the project where the associative array
1421                      --  value is.
1422
1423                      Orig_Package_Name : Name_Id := No_Name;
1424                      --  The name of the package, if any, where the associative
1425                      --  array value is.
1426
1427                      Orig_Package : Package_Id := No_Package;
1428                      --  The id of the package, if any, where the associative
1429                      --  array value is.
1430
1431                      New_Element : Array_Element_Id := No_Array_Element;
1432                      --  Id of a new array element created
1433
1434                      Prev_Element : Array_Element_Id := No_Array_Element;
1435                      --  Last new element id created
1436
1437                      Orig_Element : Array_Element_Id := No_Array_Element;
1438                      --  Current array element in original associative array
1439
1440                      Next_Element : Array_Element_Id := No_Array_Element;
1441                      --  Id of the array element that follows the new element.
1442                      --  This is not always nil, because values for the
1443                      --  associative array attribute may already have been
1444                      --  declared, and the array elements declared are reused.
1445
1446                   begin
1447                      --  First find if the associative array attribute already
1448                      --  has elements declared.
1449
1450                      if Pkg /= No_Package then
1451                         New_Array := In_Tree.Packages.Table
1452                                        (Pkg).Decl.Arrays;
1453
1454                      else
1455                         New_Array := In_Tree.Projects.Table
1456                                        (Project).Decl.Arrays;
1457                      end if;
1458
1459                      while New_Array /= No_Array
1460                        and then In_Tree.Arrays.Table (New_Array).Name /=
1461                                                            Current_Item_Name
1462                      loop
1463                         New_Array := In_Tree.Arrays.Table (New_Array).Next;
1464                      end loop;
1465
1466                      --  If the attribute has never been declared add new entry
1467                      --  in the arrays of the project/package and link it.
1468
1469                      if New_Array = No_Array then
1470                         Array_Table.Increment_Last (In_Tree.Arrays);
1471                         New_Array := Array_Table.Last (In_Tree.Arrays);
1472
1473                         if Pkg /= No_Package then
1474                            In_Tree.Arrays.Table (New_Array) :=
1475                              (Name  => Current_Item_Name,
1476                               Value => No_Array_Element,
1477                               Next  =>
1478                                 In_Tree.Packages.Table (Pkg).Decl.Arrays);
1479
1480                            In_Tree.Packages.Table (Pkg).Decl.Arrays :=
1481                              New_Array;
1482
1483                         else
1484                            In_Tree.Arrays.Table (New_Array) :=
1485                              (Name  => Current_Item_Name,
1486                               Value => No_Array_Element,
1487                               Next  =>
1488                                 In_Tree.Projects.Table (Project).Decl.Arrays);
1489
1490                            In_Tree.Projects.Table (Project).Decl.Arrays :=
1491                              New_Array;
1492                         end if;
1493                      end if;
1494
1495                      --  Find the project where the value is declared
1496
1497                      Orig_Project_Name :=
1498                        Name_Of
1499                          (Associative_Project_Of
1500                               (Current_Item, From_Project_Node_Tree),
1501                           From_Project_Node_Tree);
1502
1503                      for Index in Project_Table.First ..
1504                                   Project_Table.Last
1505                                     (In_Tree.Projects)
1506                      loop
1507                         if In_Tree.Projects.Table (Index).Name =
1508                                                            Orig_Project_Name
1509                         then
1510                            Orig_Project := Index;
1511                            exit;
1512                         end if;
1513                      end loop;
1514
1515                      pragma Assert (Orig_Project /= No_Project,
1516                                     "original project not found");
1517
1518                      if Associative_Package_Of
1519                           (Current_Item, From_Project_Node_Tree) = Empty_Node
1520                      then
1521                         Orig_Array :=
1522                           In_Tree.Projects.Table
1523                             (Orig_Project).Decl.Arrays;
1524
1525                      else
1526                         --  If in a package, find the package where the value
1527                         --  is declared.
1528
1529                         Orig_Package_Name :=
1530                           Name_Of
1531                             (Associative_Package_Of
1532                                  (Current_Item, From_Project_Node_Tree),
1533                              From_Project_Node_Tree);
1534
1535                         Orig_Package :=
1536                           In_Tree.Projects.Table
1537                             (Orig_Project).Decl.Packages;
1538                         pragma Assert (Orig_Package /= No_Package,
1539                                        "original package not found");
1540
1541                         while In_Tree.Packages.Table
1542                                 (Orig_Package).Name /= Orig_Package_Name
1543                         loop
1544                            Orig_Package := In_Tree.Packages.Table
1545                                              (Orig_Package).Next;
1546                            pragma Assert (Orig_Package /= No_Package,
1547                                           "original package not found");
1548                         end loop;
1549
1550                         Orig_Array :=
1551                           In_Tree.Packages.Table
1552                             (Orig_Package).Decl.Arrays;
1553                      end if;
1554
1555                      --  Now look for the array
1556
1557                      while Orig_Array /= No_Array
1558                        and then In_Tree.Arrays.Table (Orig_Array).Name /=
1559                                                          Current_Item_Name
1560                      loop
1561                         Orig_Array := In_Tree.Arrays.Table
1562                                         (Orig_Array).Next;
1563                      end loop;
1564
1565                      if Orig_Array = No_Array then
1566                         if Error_Report = null then
1567                            Error_Msg
1568                              ("associative array value cannot be found",
1569                               Location_Of
1570                                 (Current_Item, From_Project_Node_Tree));
1571                         else
1572                            Error_Report
1573                              ("associative array value cannot be found",
1574                               Project, In_Tree);
1575                         end if;
1576
1577                      else
1578                         Orig_Element :=
1579                           In_Tree.Arrays.Table (Orig_Array).Value;
1580
1581                         --  Copy each array element
1582
1583                         while Orig_Element /= No_Array_Element loop
1584
1585                            --  Case of first element
1586
1587                            if Prev_Element = No_Array_Element then
1588
1589                               --  And there is no array element declared yet,
1590                               --  create a new first array element.
1591
1592                               if In_Tree.Arrays.Table (New_Array).Value =
1593                                                               No_Array_Element
1594                               then
1595                                  Array_Element_Table.Increment_Last
1596                                    (In_Tree.Array_Elements);
1597                                  New_Element := Array_Element_Table.Last
1598                                    (In_Tree.Array_Elements);
1599                                  In_Tree.Arrays.Table
1600                                    (New_Array).Value := New_Element;
1601                                  Next_Element := No_Array_Element;
1602
1603                               --  Otherwise, the new element is the first
1604
1605                               else
1606                                  New_Element := In_Tree.Arrays.
1607                                                   Table (New_Array).Value;
1608                                  Next_Element :=
1609                                    In_Tree.Array_Elements.Table
1610                                      (New_Element).Next;
1611                               end if;
1612
1613                            --  Otherwise, reuse an existing element, or create
1614                            --  one if necessary.
1615
1616                            else
1617                               Next_Element :=
1618                                 In_Tree.Array_Elements.Table
1619                                   (Prev_Element).Next;
1620
1621                               if Next_Element = No_Array_Element then
1622                                  Array_Element_Table.Increment_Last
1623                                    (In_Tree.Array_Elements);
1624                                  New_Element :=
1625                                    Array_Element_Table.Last
1626                                     (In_Tree.Array_Elements);
1627                                  In_Tree.Array_Elements.Table
1628                                    (Prev_Element).Next := New_Element;
1629
1630                               else
1631                                  New_Element := Next_Element;
1632                                  Next_Element :=
1633                                    In_Tree.Array_Elements.Table
1634                                      (New_Element).Next;
1635                               end if;
1636                            end if;
1637
1638                            --  Copy the value of the element
1639
1640                            In_Tree.Array_Elements.Table
1641                              (New_Element) :=
1642                                In_Tree.Array_Elements.Table (Orig_Element);
1643                            In_Tree.Array_Elements.Table
1644                              (New_Element).Value.Project := Project;
1645
1646                            --  Adjust the Next link
1647
1648                            In_Tree.Array_Elements.Table
1649                              (New_Element).Next := Next_Element;
1650
1651                            --  Adjust the previous id for the next element
1652
1653                            Prev_Element := New_Element;
1654
1655                            --  Go to the next element in the original array
1656
1657                            Orig_Element :=
1658                              In_Tree.Array_Elements.Table
1659                                (Orig_Element).Next;
1660                         end loop;
1661
1662                         --  Make sure that the array ends here, in case there
1663                         --  previously a greater number of elements.
1664
1665                         In_Tree.Array_Elements.Table
1666                           (New_Element).Next := No_Array_Element;
1667                      end if;
1668                   end;
1669
1670                --  Declarations other that full associative arrays
1671
1672                else
1673                   declare
1674                      New_Value : constant Variable_Value :=
1675                        Expression
1676                          (Project                => Project,
1677                           In_Tree                => In_Tree,
1678                           From_Project_Node      => From_Project_Node,
1679                           From_Project_Node_Tree => From_Project_Node_Tree,
1680                           Pkg                    => Pkg,
1681                           First_Term             =>
1682                             Tree.First_Term
1683                               (Expression_Of
1684                                    (Current_Item, From_Project_Node_Tree),
1685                                From_Project_Node_Tree),
1686                           Kind                   =>
1687                             Expression_Kind_Of
1688                               (Current_Item, From_Project_Node_Tree));
1689                      --  The expression value
1690
1691                      The_Variable : Variable_Id := No_Variable;
1692
1693                      Current_Item_Name : constant Name_Id :=
1694                                            Name_Of
1695                                              (Current_Item,
1696                                               From_Project_Node_Tree);
1697
1698                   begin
1699                      --  Process a typed variable declaration
1700
1701                      if Kind_Of (Current_Item, From_Project_Node_Tree) =
1702                           N_Typed_Variable_Declaration
1703                      then
1704                         --  Report an error for an empty string
1705
1706                         if New_Value.Value = Empty_String then
1707                            Error_Msg_Name_1 :=
1708                              Name_Of (Current_Item, From_Project_Node_Tree);
1709
1710                            if Error_Report = null then
1711                               Error_Msg
1712                                 ("no value defined for %%",
1713                                  Location_Of
1714                                    (Current_Item, From_Project_Node_Tree));
1715                            else
1716                               Error_Report
1717                                 ("no value defined for " &
1718                                  Get_Name_String (Error_Msg_Name_1),
1719                                  Project, In_Tree);
1720                            end if;
1721
1722                         else
1723                            declare
1724                               Current_String : Project_Node_Id;
1725
1726                            begin
1727                               --  Loop through all the valid strings for the
1728                               --  string type and compare to the string value.
1729
1730                               Current_String :=
1731                                 First_Literal_String
1732                                   (String_Type_Of (Current_Item,
1733                                                    From_Project_Node_Tree),
1734                                                    From_Project_Node_Tree);
1735                               while Current_String /= Empty_Node
1736                                 and then
1737                                   String_Value_Of
1738                                     (Current_String, From_Project_Node_Tree) /=
1739                                                                New_Value.Value
1740                               loop
1741                                  Current_String :=
1742                                    Next_Literal_String
1743                                      (Current_String, From_Project_Node_Tree);
1744                               end loop;
1745
1746                               --  Report an error if the string value is not
1747                               --  one for the string type.
1748
1749                               if Current_String = Empty_Node then
1750                                  Error_Msg_Name_1 := New_Value.Value;
1751                                  Error_Msg_Name_2 :=
1752                                    Name_Of
1753                                      (Current_Item, From_Project_Node_Tree);
1754
1755                                  if Error_Report = null then
1756                                     Error_Msg
1757                                       ("value %% is illegal " &
1758                                        "for typed string %%",
1759                                        Location_Of
1760                                          (Current_Item,
1761                                           From_Project_Node_Tree));
1762
1763                                  else
1764                                     Error_Report
1765                                       ("value """ &
1766                                        Get_Name_String (Error_Msg_Name_1) &
1767                                        """ is illegal for typed string """ &
1768                                        Get_Name_String (Error_Msg_Name_2) &
1769                                        """",
1770                                        Project, In_Tree);
1771                                  end if;
1772                               end if;
1773                            end;
1774                         end if;
1775                      end if;
1776
1777                      --  Comment here ???
1778
1779                      if Kind_Of (Current_Item, From_Project_Node_Tree) /=
1780                           N_Attribute_Declaration
1781                        or else
1782                          Associative_Array_Index_Of
1783                            (Current_Item, From_Project_Node_Tree) = No_Name
1784                      then
1785                         --  Case of a variable declaration or of a not
1786                         --  associative array attribute.
1787
1788                         --  First, find the list where to find the variable
1789                         --  or attribute.
1790
1791                         if Kind_Of (Current_Item, From_Project_Node_Tree) =
1792                              N_Attribute_Declaration
1793                         then
1794                            if Pkg /= No_Package then
1795                               The_Variable :=
1796                                 In_Tree.Packages.Table
1797                                   (Pkg).Decl.Attributes;
1798                            else
1799                               The_Variable :=
1800                                 In_Tree.Projects.Table
1801                                   (Project).Decl.Attributes;
1802                            end if;
1803
1804                         else
1805                            if Pkg /= No_Package then
1806                               The_Variable :=
1807                                 In_Tree.Packages.Table
1808                                   (Pkg).Decl.Variables;
1809                            else
1810                               The_Variable :=
1811                                 In_Tree.Projects.Table
1812                                   (Project).Decl.Variables;
1813                            end if;
1814
1815                         end if;
1816
1817                         --  Loop through the list, to find if it has already
1818                         --  been declared.
1819
1820                         while The_Variable /= No_Variable
1821                           and then
1822                             In_Tree.Variable_Elements.Table
1823                               (The_Variable).Name /= Current_Item_Name
1824                         loop
1825                            The_Variable :=
1826                              In_Tree.Variable_Elements.Table
1827                                (The_Variable).Next;
1828                         end loop;
1829
1830                         --  If it has not been declared, create a new entry
1831                         --  in the list.
1832
1833                         if The_Variable = No_Variable then
1834
1835                            --  All single string attribute should already have
1836                            --  been declared with a default empty string value.
1837
1838                            pragma Assert
1839                              (Kind_Of (Current_Item, From_Project_Node_Tree) /=
1840                                 N_Attribute_Declaration,
1841                               "illegal attribute declaration");
1842
1843                            Variable_Element_Table.Increment_Last
1844                              (In_Tree.Variable_Elements);
1845                            The_Variable := Variable_Element_Table.Last
1846                              (In_Tree.Variable_Elements);
1847
1848                            --  Put the new variable in the appropriate list
1849
1850                            if Pkg /= No_Package then
1851                               In_Tree.Variable_Elements.Table (The_Variable) :=
1852                                 (Next    =>
1853                                    In_Tree.Packages.Table
1854                                      (Pkg).Decl.Variables,
1855                                  Name    => Current_Item_Name,
1856                                  Value   => New_Value);
1857                               In_Tree.Packages.Table
1858                                 (Pkg).Decl.Variables := The_Variable;
1859
1860                            else
1861                               In_Tree.Variable_Elements.Table (The_Variable) :=
1862                                 (Next    =>
1863                                    In_Tree.Projects.Table
1864                                      (Project).Decl.Variables,
1865                                  Name    => Current_Item_Name,
1866                                  Value   => New_Value);
1867                               In_Tree.Projects.Table
1868                                 (Project).Decl.Variables :=
1869                                   The_Variable;
1870                            end if;
1871
1872                         --  If the variable/attribute has already been
1873                         --  declared, just change the value.
1874
1875                         else
1876                            In_Tree.Variable_Elements.Table
1877                              (The_Variable).Value := New_Value;
1878                         end if;
1879
1880                      --  Associative array attribute
1881
1882                      else
1883                         --  Get the string index
1884
1885                         Get_Name_String
1886                           (Associative_Array_Index_Of
1887                              (Current_Item, From_Project_Node_Tree));
1888
1889                         --  Put in lower case, if necessary
1890
1891                         declare
1892                            Lower : Boolean;
1893
1894                         begin
1895                            Lower :=
1896                              Case_Insensitive
1897                                (Current_Item, From_Project_Node_Tree);
1898
1899                            --  In multi-language mode (gprbuild), the index is
1900                            --  always case insensitive if it does not include
1901                            --  any dot.
1902
1903                            if Get_Mode = Multi_Language and then not Lower then
1904                               for J in 1 .. Name_Len loop
1905                                  if Name_Buffer (J) = '.' then
1906                                     Lower := False;
1907                                     exit;
1908                                  end if;
1909                               end loop;
1910                            end if;
1911
1912                            if Lower then
1913                               GNAT.Case_Util.To_Lower
1914                                 (Name_Buffer (1 .. Name_Len));
1915                            end if;
1916                         end;
1917
1918                         declare
1919                            The_Array : Array_Id;
1920
1921                            The_Array_Element : Array_Element_Id :=
1922                                                  No_Array_Element;
1923
1924                            Index_Name : constant Name_Id := Name_Find;
1925                            --  The name id of the index
1926
1927                         begin
1928                            --  Look for the array in the appropriate list
1929
1930                            if Pkg /= No_Package then
1931                               The_Array :=
1932                                 In_Tree.Packages.Table (Pkg).Decl.Arrays;
1933
1934                            else
1935                               The_Array :=
1936                                 In_Tree.Projects.Table (Project).Decl.Arrays;
1937                            end if;
1938
1939                            while
1940                              The_Array /= No_Array
1941                                and then
1942                                  In_Tree.Arrays.Table (The_Array).Name /=
1943                                                             Current_Item_Name
1944                            loop
1945                               The_Array := In_Tree.Arrays.Table
1946                                              (The_Array).Next;
1947                            end loop;
1948
1949                            --  If the array cannot be found, create a new entry
1950                            --  in the list. As The_Array_Element is initialized
1951                            --  to No_Array_Element, a new element will be
1952                            --  created automatically later
1953
1954                            if The_Array = No_Array then
1955                               Array_Table.Increment_Last (In_Tree.Arrays);
1956                               The_Array := Array_Table.Last (In_Tree.Arrays);
1957
1958                               if Pkg /= No_Package then
1959                                  In_Tree.Arrays.Table (The_Array) :=
1960                                    (Name  => Current_Item_Name,
1961                                     Value => No_Array_Element,
1962                                     Next  =>
1963                                       In_Tree.Packages.Table
1964                                         (Pkg).Decl.Arrays);
1965
1966                                  In_Tree.Packages.Table (Pkg).Decl.Arrays :=
1967                                      The_Array;
1968
1969                               else
1970                                  In_Tree.Arrays.Table (The_Array) :=
1971                                    (Name  => Current_Item_Name,
1972                                     Value => No_Array_Element,
1973                                     Next  =>
1974                                       In_Tree.Projects.Table
1975                                         (Project).Decl.Arrays);
1976
1977                                  In_Tree.Projects.Table
1978                                    (Project).Decl.Arrays := The_Array;
1979                               end if;
1980
1981                            --  Otherwise initialize The_Array_Element as the
1982                            --  head of the element list.
1983
1984                            else
1985                               The_Array_Element :=
1986                                 In_Tree.Arrays.Table (The_Array).Value;
1987                            end if;
1988
1989                            --  Look in the list, if any, to find an element
1990                            --  with the same index.
1991
1992                            while The_Array_Element /= No_Array_Element
1993                              and then
1994                                In_Tree.Array_Elements.Table
1995                                  (The_Array_Element).Index /= Index_Name
1996                            loop
1997                               The_Array_Element :=
1998                                 In_Tree.Array_Elements.Table
1999                                   (The_Array_Element).Next;
2000                            end loop;
2001
2002                            --  If no such element were found, create a new one
2003                            --  and insert it in the element list, with the
2004                            --  proper value.
2005
2006                            if The_Array_Element = No_Array_Element then
2007                               Array_Element_Table.Increment_Last
2008                                 (In_Tree.Array_Elements);
2009                               The_Array_Element := Array_Element_Table.Last
2010                                 (In_Tree.Array_Elements);
2011
2012                               In_Tree.Array_Elements.Table
2013                                 (The_Array_Element) :=
2014                                   (Index  => Index_Name,
2015                                    Src_Index =>
2016                                      Source_Index_Of
2017                                        (Current_Item, From_Project_Node_Tree),
2018                                    Index_Case_Sensitive =>
2019                                      not Case_Insensitive
2020                                        (Current_Item, From_Project_Node_Tree),
2021                                    Value  => New_Value,
2022                                    Next => In_Tree.Arrays.Table
2023                                              (The_Array).Value);
2024                               In_Tree.Arrays.Table
2025                                 (The_Array).Value := The_Array_Element;
2026
2027                            --  An element with the same index already exists,
2028                            --  just replace its value with the new one.
2029
2030                            else
2031                               In_Tree.Array_Elements.Table
2032                                 (The_Array_Element).Value := New_Value;
2033                            end if;
2034                         end;
2035                      end if;
2036                   end;
2037                end if;
2038
2039             when N_Case_Construction =>
2040                declare
2041                   The_Project : Project_Id := Project;
2042                   --  The id of the project of the case variable
2043
2044                   The_Package : Package_Id := Pkg;
2045                   --  The id of the package, if any, of the case variable
2046
2047                   The_Variable : Variable_Value := Nil_Variable_Value;
2048                   --  The case variable
2049
2050                   Case_Value : Name_Id := No_Name;
2051                   --  The case variable value
2052
2053                   Case_Item     : Project_Node_Id := Empty_Node;
2054                   Choice_String : Project_Node_Id := Empty_Node;
2055                   Decl_Item     : Project_Node_Id := Empty_Node;
2056
2057                begin
2058                   declare
2059                      Variable_Node : constant Project_Node_Id :=
2060                                        Case_Variable_Reference_Of
2061                                          (Current_Item,
2062                                           From_Project_Node_Tree);
2063
2064                      Var_Id : Variable_Id := No_Variable;
2065                      Name   : Name_Id     := No_Name;
2066
2067                   begin
2068                      --  If a project was specified for the case variable,
2069                      --  get its id.
2070
2071                      if Project_Node_Of
2072                        (Variable_Node, From_Project_Node_Tree) /= Empty_Node
2073                      then
2074                         Name :=
2075                           Name_Of
2076                             (Project_Node_Of
2077                                (Variable_Node, From_Project_Node_Tree),
2078                              From_Project_Node_Tree);
2079                         The_Project :=
2080                           Imported_Or_Extended_Project_From
2081                             (Project, In_Tree, Name);
2082                      end if;
2083
2084                      --  If a package were specified for the case variable,
2085                      --  get its id.
2086
2087                      if Package_Node_Of
2088                        (Variable_Node, From_Project_Node_Tree) /= Empty_Node
2089                      then
2090                         Name :=
2091                           Name_Of
2092                             (Package_Node_Of
2093                                (Variable_Node, From_Project_Node_Tree),
2094                              From_Project_Node_Tree);
2095                         The_Package :=
2096                           Package_From (The_Project, In_Tree, Name);
2097                      end if;
2098
2099                      Name := Name_Of (Variable_Node, From_Project_Node_Tree);
2100
2101                      --  First, look for the case variable into the package,
2102                      --  if any.
2103
2104                      if The_Package /= No_Package then
2105                         Var_Id := In_Tree.Packages.Table
2106                                     (The_Package).Decl.Variables;
2107                         Name :=
2108                           Name_Of (Variable_Node, From_Project_Node_Tree);
2109                         while Var_Id /= No_Variable
2110                           and then
2111                             In_Tree.Variable_Elements.Table
2112                               (Var_Id).Name /= Name
2113                         loop
2114                            Var_Id := In_Tree.Variable_Elements.
2115                                        Table (Var_Id).Next;
2116                         end loop;
2117                      end if;
2118
2119                      --  If not found in the package, or if there is no
2120                      --  package, look at the project level.
2121
2122                      if Var_Id = No_Variable
2123                         and then
2124                         Package_Node_Of
2125                           (Variable_Node, From_Project_Node_Tree) = Empty_Node
2126                      then
2127                         Var_Id := In_Tree.Projects.Table
2128                                     (The_Project).Decl.Variables;
2129                         while Var_Id /= No_Variable
2130                           and then
2131                             In_Tree.Variable_Elements.Table
2132                               (Var_Id).Name /= Name
2133                         loop
2134                            Var_Id := In_Tree.Variable_Elements.
2135                                        Table (Var_Id).Next;
2136                         end loop;
2137                      end if;
2138
2139                      if Var_Id = No_Variable then
2140
2141                         --  Should never happen, because this has already been
2142                         --  checked during parsing.
2143
2144                         Write_Line ("variable """ &
2145                                     Get_Name_String (Name) &
2146                                     """ not found");
2147                         raise Program_Error;
2148                      end if;
2149
2150                      --  Get the case variable
2151
2152                      The_Variable := In_Tree.Variable_Elements.
2153                                        Table (Var_Id).Value;
2154
2155                      if The_Variable.Kind /= Single then
2156
2157                         --  Should never happen, because this has already been
2158                         --  checked during parsing.
2159
2160                         Write_Line ("variable""" &
2161                                     Get_Name_String (Name) &
2162                                     """ is not a single string variable");
2163                         raise Program_Error;
2164                      end if;
2165
2166                      --  Get the case variable value
2167                      Case_Value := The_Variable.Value;
2168                   end;
2169
2170                   --  Now look into all the case items of the case construction
2171
2172                   Case_Item :=
2173                     First_Case_Item_Of (Current_Item, From_Project_Node_Tree);
2174                   Case_Item_Loop :
2175                      while Case_Item /= Empty_Node loop
2176                         Choice_String :=
2177                           First_Choice_Of (Case_Item, From_Project_Node_Tree);
2178
2179                         --  When Choice_String is nil, it means that it is
2180                         --  the "when others =>" alternative.
2181
2182                         if Choice_String = Empty_Node then
2183                            Decl_Item :=
2184                              First_Declarative_Item_Of
2185                                (Case_Item, From_Project_Node_Tree);
2186                            exit Case_Item_Loop;
2187                         end if;
2188
2189                         --  Look into all the alternative of this case item
2190
2191                         Choice_Loop :
2192                            while Choice_String /= Empty_Node loop
2193                               if Case_Value =
2194                                 String_Value_Of
2195                                   (Choice_String, From_Project_Node_Tree)
2196                               then
2197                                  Decl_Item :=
2198                                    First_Declarative_Item_Of
2199                                      (Case_Item, From_Project_Node_Tree);
2200                                  exit Case_Item_Loop;
2201                               end if;
2202
2203                               Choice_String :=
2204                                 Next_Literal_String
2205                                   (Choice_String, From_Project_Node_Tree);
2206                            end loop Choice_Loop;
2207
2208                         Case_Item :=
2209                           Next_Case_Item (Case_Item, From_Project_Node_Tree);
2210                      end loop Case_Item_Loop;
2211
2212                   --  If there is an alternative, then we process it
2213
2214                   if Decl_Item /= Empty_Node then
2215                      Process_Declarative_Items
2216                        (Project                => Project,
2217                         In_Tree                => In_Tree,
2218                         From_Project_Node      => From_Project_Node,
2219                         From_Project_Node_Tree => From_Project_Node_Tree,
2220                         Pkg                    => Pkg,
2221                         Item                   => Decl_Item);
2222                   end if;
2223                end;
2224
2225             when others =>
2226
2227                --  Should never happen
2228
2229                Write_Line ("Illegal declarative item: " &
2230                            Project_Node_Kind'Image
2231                              (Kind_Of
2232                                 (Current_Item, From_Project_Node_Tree)));
2233                raise Program_Error;
2234          end case;
2235       end loop;
2236    end Process_Declarative_Items;
2237
2238    ----------------------------------
2239    -- Process_Project_Tree_Phase_1 --
2240    ----------------------------------
2241
2242    procedure Process_Project_Tree_Phase_1
2243      (In_Tree                : Project_Tree_Ref;
2244       Project                : out Project_Id;
2245       Success                : out Boolean;
2246       From_Project_Node      : Project_Node_Id;
2247       From_Project_Node_Tree : Project_Node_Tree_Ref;
2248       Report_Error           : Put_Line_Access;
2249       Reset_Tree             : Boolean := True)
2250    is
2251    begin
2252       Error_Report := Report_Error;
2253
2254       if Reset_Tree then
2255
2256          --  Make sure there are no projects in the data structure
2257
2258          Project_Table.Set_Last (In_Tree.Projects, No_Project);
2259       end if;
2260
2261       Processed_Projects.Reset;
2262
2263       --  And process the main project and all of the projects it depends on,
2264       --  recursively.
2265
2266       Recursive_Process
2267         (Project                => Project,
2268          In_Tree                => In_Tree,
2269          From_Project_Node      => From_Project_Node,
2270          From_Project_Node_Tree => From_Project_Node_Tree,
2271          Extended_By            => No_Project);
2272
2273       Success :=
2274         Total_Errors_Detected = 0
2275           and then
2276             (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
2277    end Process_Project_Tree_Phase_1;
2278
2279    ----------------------------------
2280    -- Process_Project_Tree_Phase_2 --
2281    ----------------------------------
2282
2283    procedure Process_Project_Tree_Phase_2
2284      (In_Tree                : Project_Tree_Ref;
2285       Project                : Project_Id;
2286       Success                : out Boolean;
2287       From_Project_Node      : Project_Node_Id;
2288       From_Project_Node_Tree : Project_Node_Tree_Ref;
2289       Report_Error           : Put_Line_Access;
2290       When_No_Sources        : Error_Warning := Error;
2291       Current_Dir            : String)
2292    is
2293       Obj_Dir    : Path_Name_Type;
2294       Extending  : Project_Id;
2295       Extending2 : Project_Id;
2296
2297    --  Start of processing for Process_Project_Tree_Phase_2
2298
2299    begin
2300       Error_Report := Report_Error;
2301       Success := True;
2302
2303       if Project /= No_Project then
2304          Check (In_Tree, Project, Current_Dir, When_No_Sources);
2305       end if;
2306
2307       --  If main project is an extending all project, set the object
2308       --  directory of all virtual extending projects to the object
2309       --  directory of the main project.
2310
2311       if Project /= No_Project
2312         and then
2313           Is_Extending_All (From_Project_Node, From_Project_Node_Tree)
2314       then
2315          declare
2316             Object_Dir : constant Path_Name_Type :=
2317                            In_Tree.Projects.Table
2318                              (Project).Object_Directory;
2319          begin
2320             for Index in
2321               Project_Table.First .. Project_Table.Last (In_Tree.Projects)
2322             loop
2323                if In_Tree.Projects.Table (Index).Virtual then
2324                   In_Tree.Projects.Table (Index).Object_Directory :=
2325                     Object_Dir;
2326                end if;
2327             end loop;
2328          end;
2329       end if;
2330
2331       --  Check that no extending project shares its object directory with
2332       --  the project(s) it extends.
2333
2334       if Project /= No_Project then
2335          for Proj in
2336            Project_Table.First .. Project_Table.Last (In_Tree.Projects)
2337          loop
2338             Extending := In_Tree.Projects.Table (Proj).Extended_By;
2339
2340             if Extending /= No_Project then
2341                Obj_Dir := In_Tree.Projects.Table (Proj).Object_Directory;
2342
2343                --  Check that a project being extended does not share its
2344                --  object directory with any project that extends it, directly
2345                --  or indirectly, including a virtual extending project.
2346
2347                --  Start with the project directly extending it
2348
2349                Extending2 := Extending;
2350                while Extending2 /= No_Project loop
2351                   if In_Tree.Projects.Table (Extending2).Ada_Sources /=
2352                     Nil_String
2353                     and then
2354                       In_Tree.Projects.Table (Extending2).Object_Directory =
2355                       Obj_Dir
2356                   then
2357                      if In_Tree.Projects.Table (Extending2).Virtual then
2358                         Error_Msg_Name_1 :=
2359                           In_Tree.Projects.Table (Proj).Display_Name;
2360
2361                         if Error_Report = null then
2362                            Error_Msg
2363                              ("project %% cannot be extended by a virtual" &
2364                               " project with the same object directory",
2365                               In_Tree.Projects.Table (Proj).Location);
2366                         else
2367                            Error_Report
2368                              ("project """ &
2369                               Get_Name_String (Error_Msg_Name_1) &
2370                               """ cannot be extended by a virtual " &
2371                               "project with the same object directory",
2372                               Project, In_Tree);
2373                         end if;
2374
2375                      else
2376                         Error_Msg_Name_1 :=
2377                           In_Tree.Projects.Table (Extending2).Display_Name;
2378                         Error_Msg_Name_2 :=
2379                           In_Tree.Projects.Table (Proj).Display_Name;
2380
2381                         if Error_Report = null then
2382                            Error_Msg
2383                              ("project %% cannot extend project %%",
2384                               In_Tree.Projects.Table (Extending2).Location);
2385                            Error_Msg
2386                              ("\they share the same object directory",
2387                               In_Tree.Projects.Table (Extending2).Location);
2388
2389                         else
2390                            Error_Report
2391                              ("project """ &
2392                               Get_Name_String (Error_Msg_Name_1) &
2393                               """ cannot extend project """ &
2394                               Get_Name_String (Error_Msg_Name_2) & """",
2395                               Project, In_Tree);
2396                            Error_Report
2397                              ("they share the same object directory",
2398                               Project, In_Tree);
2399                         end if;
2400                      end if;
2401                   end if;
2402
2403                   --  Continue with the next extending project, if any
2404
2405                   Extending2 :=
2406                     In_Tree.Projects.Table (Extending2).Extended_By;
2407                end loop;
2408             end if;
2409          end loop;
2410       end if;
2411
2412       Success :=
2413         Total_Errors_Detected = 0
2414           and then
2415             (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
2416    end Process_Project_Tree_Phase_2;
2417
2418    ---------------------
2419    -- Recursive_Check --
2420    ---------------------
2421
2422    procedure Recursive_Check
2423      (Project         : Project_Id;
2424       In_Tree         : Project_Tree_Ref;
2425       Current_Dir     : String;
2426       When_No_Sources : Error_Warning)
2427    is
2428       Data                  : Project_Data;
2429       Imported_Project_List : Project_List := Empty_Project_List;
2430
2431    begin
2432       --  Do nothing if Project is No_Project, or Project has already
2433       --  been marked as checked.
2434
2435       if Project /= No_Project
2436         and then not In_Tree.Projects.Table (Project).Checked
2437       then
2438          --  Mark project as checked, to avoid infinite recursion in
2439          --  ill-formed trees, where a project imports itself.
2440
2441          In_Tree.Projects.Table (Project).Checked := True;
2442
2443          Data := In_Tree.Projects.Table (Project);
2444
2445          --  Call itself for a possible extended project.
2446          --  (if there is no extended project, then nothing happens).
2447
2448          Recursive_Check (Data.Extends, In_Tree, Current_Dir, When_No_Sources);
2449
2450          --  Call itself for all imported projects
2451
2452          Imported_Project_List := Data.Imported_Projects;
2453          while Imported_Project_List /= Empty_Project_List loop
2454             Recursive_Check
2455               (In_Tree.Project_Lists.Table
2456                  (Imported_Project_List).Project,
2457                In_Tree, Current_Dir, When_No_Sources);
2458             Imported_Project_List :=
2459               In_Tree.Project_Lists.Table
2460                 (Imported_Project_List).Next;
2461          end loop;
2462
2463          if Verbose_Mode then
2464             Write_Str ("Checking project file """);
2465             Write_Str (Get_Name_String (Data.Name));
2466             Write_Line ("""");
2467          end if;
2468
2469          Prj.Nmsc.Check
2470            (Project, In_Tree, Error_Report, When_No_Sources,
2471             Current_Dir);
2472       end if;
2473    end Recursive_Check;
2474
2475    -----------------------
2476    -- Recursive_Process --
2477    -----------------------
2478
2479    procedure Recursive_Process
2480      (In_Tree                : Project_Tree_Ref;
2481       Project                : out Project_Id;
2482       From_Project_Node      : Project_Node_Id;
2483       From_Project_Node_Tree : Project_Node_Tree_Ref;
2484       Extended_By            : Project_Id)
2485    is
2486       With_Clause : Project_Node_Id;
2487
2488    begin
2489       if From_Project_Node = Empty_Node then
2490          Project := No_Project;
2491
2492       else
2493          declare
2494             Processed_Data   : Project_Data     := Empty_Project (In_Tree);
2495             Imported         : Project_List     := Empty_Project_List;
2496             Declaration_Node : Project_Node_Id  := Empty_Node;
2497             Tref             : Source_Buffer_Ptr;
2498             Name             : constant Name_Id :=
2499                                  Name_Of
2500                                    (From_Project_Node, From_Project_Node_Tree);
2501             Location         : Source_Ptr :=
2502                                  Location_Of
2503                                    (From_Project_Node, From_Project_Node_Tree);
2504
2505          begin
2506             Project := Processed_Projects.Get (Name);
2507
2508             if Project /= No_Project then
2509
2510                --  Make sure that, when a project is extended, the project id
2511                --  of the project extending it is recorded in its data, even
2512                --  when it has already been processed as an imported project.
2513                --  This is for virtually extended projects.
2514
2515                if Extended_By /= No_Project then
2516                   In_Tree.Projects.Table (Project).Extended_By := Extended_By;
2517                end if;
2518
2519                return;
2520             end if;
2521
2522             Project_Table.Increment_Last (In_Tree.Projects);
2523             Project := Project_Table.Last (In_Tree.Projects);
2524             Processed_Projects.Set (Name, Project);
2525
2526             Processed_Data.Name := Name;
2527             Processed_Data.Qualifier :=
2528               Project_Qualifier_Of (From_Project_Node, From_Project_Node_Tree);
2529             In_Tree.Projects.Table (Project).Name := Name;
2530             In_Tree.Projects.Table (Project).Qualifier :=
2531               Processed_Data.Qualifier;
2532
2533             Get_Name_String (Name);
2534
2535             --  If name starts with the virtual prefix, flag the project as
2536             --  being a virtual extending project.
2537
2538             if Name_Len > Virtual_Prefix'Length
2539               and then Name_Buffer (1 .. Virtual_Prefix'Length) =
2540                          Virtual_Prefix
2541             then
2542                Processed_Data.Virtual := True;
2543                Processed_Data.Display_Name := Name;
2544
2545             --  If there is no file, for example when the project node tree is
2546             --  built in memory by GPS, the Display_Name cannot be found in
2547             --  the source, so its value is the same as Name.
2548
2549             elsif Location = No_Location then
2550                Processed_Data.Display_Name := Name;
2551
2552             --  Get the spelling of the project name from the project file
2553
2554             else
2555                Tref := Source_Text (Get_Source_File_Index (Location));
2556
2557                for J in 1 .. Name_Len loop
2558                   Name_Buffer (J) := Tref (Location);
2559                   Location := Location + 1;
2560                end loop;
2561
2562                Processed_Data.Display_Name := Name_Find;
2563             end if;
2564
2565             Processed_Data.Display_Path_Name :=
2566               Path_Name_Of (From_Project_Node, From_Project_Node_Tree);
2567             Get_Name_String (Processed_Data.Display_Path_Name);
2568             Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2569             Processed_Data.Path_Name := Name_Find;
2570
2571             Processed_Data.Location :=
2572               Location_Of (From_Project_Node, From_Project_Node_Tree);
2573
2574             Processed_Data.Display_Directory :=
2575               Directory_Of (From_Project_Node, From_Project_Node_Tree);
2576             Get_Name_String (Processed_Data.Display_Directory);
2577             Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2578             Processed_Data.Directory := Name_Find;
2579
2580             Processed_Data.Extended_By := Extended_By;
2581
2582             Add_Attributes
2583               (Project,
2584                Name,
2585                In_Tree,
2586                Processed_Data.Decl,
2587                Prj.Attr.Attribute_First,
2588                Project_Level => True);
2589
2590             --  Process non limited withed projects
2591
2592             With_Clause :=
2593               First_With_Clause_Of (From_Project_Node, From_Project_Node_Tree);
2594             while With_Clause /= Empty_Node loop
2595                declare
2596                   New_Project : Project_Id;
2597                   New_Data    : Project_Data;
2598                   Proj_Node   : Project_Node_Id;
2599
2600                begin
2601                   Proj_Node :=
2602                     Non_Limited_Project_Node_Of
2603                       (With_Clause, From_Project_Node_Tree);
2604
2605                   if Proj_Node /= Empty_Node then
2606                      Recursive_Process
2607                        (In_Tree                => In_Tree,
2608                         Project                => New_Project,
2609                         From_Project_Node      =>
2610                           Project_Node_Of
2611                             (With_Clause, From_Project_Node_Tree),
2612                         From_Project_Node_Tree => From_Project_Node_Tree,
2613                         Extended_By            => No_Project);
2614
2615                      New_Data :=
2616                        In_Tree.Projects.Table (New_Project);
2617
2618                      --  If we were the first project to import it,
2619                      --  set First_Referred_By to us.
2620
2621                      if New_Data.First_Referred_By = No_Project then
2622                         New_Data.First_Referred_By := Project;
2623                         In_Tree.Projects.Table (New_Project) :=
2624                           New_Data;
2625                      end if;
2626
2627                      --  Add this project to our list of imported projects
2628
2629                      Project_List_Table.Increment_Last
2630                        (In_Tree.Project_Lists);
2631
2632                      In_Tree.Project_Lists.Table
2633                        (Project_List_Table.Last
2634                           (In_Tree.Project_Lists)) :=
2635                        (Project => New_Project, Next => Empty_Project_List);
2636
2637                      --  Imported is the id of the last imported project. If it
2638                      --  is nil, then this imported project is our first.
2639
2640                      if Imported = Empty_Project_List then
2641                         Processed_Data.Imported_Projects :=
2642                           Project_List_Table.Last
2643                             (In_Tree.Project_Lists);
2644
2645                      else
2646                         In_Tree.Project_Lists.Table
2647                           (Imported).Next := Project_List_Table.Last
2648                           (In_Tree.Project_Lists);
2649                      end if;
2650
2651                      Imported := Project_List_Table.Last
2652                        (In_Tree.Project_Lists);
2653                   end if;
2654
2655                   With_Clause :=
2656                     Next_With_Clause_Of
2657                       (With_Clause, From_Project_Node_Tree);
2658                end;
2659             end loop;
2660
2661             Declaration_Node :=
2662               Project_Declaration_Of
2663                 (From_Project_Node, From_Project_Node_Tree);
2664
2665             Recursive_Process
2666               (In_Tree                => In_Tree,
2667                Project                => Processed_Data.Extends,
2668                From_Project_Node      => Extended_Project_Of
2669                                           (Declaration_Node,
2670                                            From_Project_Node_Tree),
2671                From_Project_Node_Tree => From_Project_Node_Tree,
2672                Extended_By            => Project);
2673
2674             In_Tree.Projects.Table (Project) := Processed_Data;
2675
2676             Process_Declarative_Items
2677               (Project                => Project,
2678                In_Tree                => In_Tree,
2679                From_Project_Node      => From_Project_Node,
2680                From_Project_Node_Tree => From_Project_Node_Tree,
2681                Pkg                    => No_Package,
2682                Item                   => First_Declarative_Item_Of
2683                                           (Declaration_Node,
2684                                            From_Project_Node_Tree));
2685
2686             --  If it is an extending project, inherit all packages
2687             --  from the extended project that are not explicitly defined
2688             --  or renamed. Also inherit the languages, if attribute Languages
2689             --  is not explicitly defined.
2690
2691             Processed_Data := In_Tree.Projects.Table (Project);
2692
2693             if Processed_Data.Extends /= No_Project then
2694                declare
2695                   Extended_Pkg : Package_Id;
2696                   Current_Pkg  : Package_Id;
2697                   Element      : Package_Element;
2698                   First        : constant Package_Id :=
2699                                    Processed_Data.Decl.Packages;
2700                   Attribute1   : Variable_Id;
2701                   Attribute2   : Variable_Id;
2702                   Attr_Value1  : Variable;
2703                   Attr_Value2  : Variable;
2704
2705                begin
2706                   Extended_Pkg :=
2707                     In_Tree.Projects.Table
2708                       (Processed_Data.Extends).Decl.Packages;
2709                   while Extended_Pkg /= No_Package loop
2710                      Element :=
2711                        In_Tree.Packages.Table (Extended_Pkg);
2712
2713                      Current_Pkg := First;
2714                      while Current_Pkg /= No_Package
2715                        and then In_Tree.Packages.Table (Current_Pkg).Name /=
2716                                                                  Element.Name
2717                      loop
2718                         Current_Pkg :=
2719                           In_Tree.Packages.Table (Current_Pkg).Next;
2720                      end loop;
2721
2722                      if Current_Pkg = No_Package then
2723                         Package_Table.Increment_Last
2724                           (In_Tree.Packages);
2725                         Current_Pkg := Package_Table.Last (In_Tree.Packages);
2726                         In_Tree.Packages.Table (Current_Pkg) :=
2727                           (Name   => Element.Name,
2728                            Decl   => No_Declarations,
2729                            Parent => No_Package,
2730                            Next   => Processed_Data.Decl.Packages);
2731                         Processed_Data.Decl.Packages := Current_Pkg;
2732                         Copy_Package_Declarations
2733                           (From  => Element.Decl,
2734                            To    => In_Tree.Packages.Table (Current_Pkg).Decl,
2735                            New_Loc => No_Location,
2736                            In_Tree => In_Tree);
2737                      end if;
2738
2739                      Extended_Pkg := Element.Next;
2740                   end loop;
2741
2742                   --  Check if attribute Languages is declared in the
2743                   --  extending project.
2744
2745                   Attribute1 := Processed_Data.Decl.Attributes;
2746                   while Attribute1 /= No_Variable loop
2747                      Attr_Value1 := In_Tree.Variable_Elements.
2748                                       Table (Attribute1);
2749                      exit when Attr_Value1.Name = Snames.Name_Languages;
2750                      Attribute1 := Attr_Value1.Next;
2751                   end loop;
2752
2753                   if Attribute1 = No_Variable or else
2754                      Attr_Value1.Value.Default
2755                   then
2756                      --  Attribute Languages is not declared in the extending
2757                      --  project. Check if it is declared in the project being
2758                      --  extended.
2759
2760                      Attribute2 :=
2761                        In_Tree.Projects.Table
2762                          (Processed_Data.Extends).Decl.Attributes;
2763                      while Attribute2 /= No_Variable loop
2764                         Attr_Value2 := In_Tree.Variable_Elements.
2765                                          Table (Attribute2);
2766                         exit when Attr_Value2.Name = Snames.Name_Languages;
2767                         Attribute2 := Attr_Value2.Next;
2768                      end loop;
2769
2770                      if Attribute2 /= No_Variable and then
2771                         not Attr_Value2.Value.Default
2772                      then
2773                         --  As attribute Languages is declared in the project
2774                         --  being extended, copy its value for the extending
2775                         --  project.
2776
2777                         if Attribute1 = No_Variable then
2778                            Variable_Element_Table.Increment_Last
2779                              (In_Tree.Variable_Elements);
2780                            Attribute1 := Variable_Element_Table.Last
2781                              (In_Tree.Variable_Elements);
2782                            Attr_Value1.Next := Processed_Data.Decl.Attributes;
2783                            Processed_Data.Decl.Attributes := Attribute1;
2784                         end if;
2785
2786                         Attr_Value1.Name := Snames.Name_Languages;
2787                         Attr_Value1.Value := Attr_Value2.Value;
2788                         In_Tree.Variable_Elements.Table
2789                           (Attribute1) := Attr_Value1;
2790                      end if;
2791                   end if;
2792                end;
2793
2794                In_Tree.Projects.Table (Project) := Processed_Data;
2795             end if;
2796
2797             --  Process limited withed projects
2798
2799             With_Clause :=
2800               First_With_Clause_Of
2801                 (From_Project_Node, From_Project_Node_Tree);
2802             while With_Clause /= Empty_Node loop
2803                declare
2804                   New_Project : Project_Id;
2805                   New_Data    : Project_Data;
2806                   Proj_Node   : Project_Node_Id;
2807
2808                begin
2809                   Proj_Node :=
2810                     Non_Limited_Project_Node_Of
2811                       (With_Clause, From_Project_Node_Tree);
2812
2813                   if Proj_Node = Empty_Node then
2814                      Recursive_Process
2815                        (In_Tree                => In_Tree,
2816                         Project                => New_Project,
2817                         From_Project_Node      =>
2818                           Project_Node_Of
2819                             (With_Clause, From_Project_Node_Tree),
2820                         From_Project_Node_Tree => From_Project_Node_Tree,
2821                         Extended_By            => No_Project);
2822
2823                      New_Data :=
2824                        In_Tree.Projects.Table (New_Project);
2825
2826                      --  If we were the first project to import it, set
2827                      --  First_Referred_By to us.
2828
2829                      if New_Data.First_Referred_By = No_Project then
2830                         New_Data.First_Referred_By := Project;
2831                         In_Tree.Projects.Table (New_Project) :=
2832                           New_Data;
2833                      end if;
2834
2835                      --  Add this project to our list of imported projects
2836
2837                      Project_List_Table.Increment_Last
2838                        (In_Tree.Project_Lists);
2839
2840                      In_Tree.Project_Lists.Table
2841                        (Project_List_Table.Last
2842                           (In_Tree.Project_Lists)) :=
2843                        (Project => New_Project, Next => Empty_Project_List);
2844
2845                      --  Imported is the id of the last imported project. If
2846                      --  it is nil, then this imported project is our first.
2847
2848                      if Imported = Empty_Project_List then
2849                         In_Tree.Projects.Table (Project).Imported_Projects :=
2850                           Project_List_Table.Last
2851                             (In_Tree.Project_Lists);
2852                      else
2853                         In_Tree.Project_Lists.Table
2854                           (Imported).Next := Project_List_Table.Last
2855                           (In_Tree.Project_Lists);
2856                      end if;
2857
2858                      Imported := Project_List_Table.Last
2859                        (In_Tree.Project_Lists);
2860                   end if;
2861
2862                   With_Clause :=
2863                     Next_With_Clause_Of
2864                       (With_Clause, From_Project_Node_Tree);
2865                end;
2866             end loop;
2867          end;
2868       end if;
2869    end Recursive_Process;
2870
2871 end Prj.Proc;