gcc/ada/prj-proc.adb

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