gcc/ada/prj-proc.adb

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