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 Sinput;   use Sinput;
  35 with Snames;
  36
  37 with GNAT.Case_Util; use GNAT.Case_Util;
  38 with GNAT.HTable;
  39
  40 package body Prj.Proc is
  41
  42    package Processed_Projects is new GNAT.HTable.Simple_HTable
  43      (Header_Num => Header_Num,
  44       Element    => Project_Id,
  45       No_Element => No_Project,
  46       Key        => Name_Id,
  47       Hash       => Hash,
  48       Equal      => "=");
  49    --  This hash table contains all processed projects
  50
  51    package Unit_Htable is new GNAT.HTable.Simple_HTable
  52      (Header_Num => Header_Num,
  53       Element    => Source_Id,
  54       No_Element => No_Source,
  55       Key        => Name_Id,
  56       Hash       => Hash,
  57       Equal      => "=");
  58    --  This hash table contains all processed projects
  59
  60    procedure Add (To_Exp : in out Name_Id; Str : Name_Id);
  61    --  Concatenate two strings and returns another string if both
  62    --  arguments are not null string.
  63
  64    --  In the following procedures, we are expected to guess the meaning of
  65    --  the parameters from their names, this is never a good idea, comments
  66    --  should be added precisely defining every formal ???
  67
  68    procedure Add_Attributes
  69      (Project       : Project_Id;
  70       Project_Name  : Name_Id;
  71       Project_Dir   : Name_Id;
  72       In_Tree       : Project_Tree_Ref;
  73       Decl          : in out Declarations;
  74       First         : Attribute_Node_Id;
  75       Project_Level : Boolean);
  76    --  Add all attributes, starting with First, with their default values to
  77    --  the package or project with declarations Decl.
  78
  79    procedure Check
  80      (In_Tree : Project_Tree_Ref;
  81       Project : Project_Id;
  82       Flags   : Processing_Flags);
  83    --  Set all projects to not checked, then call Recursive_Check for the
  84    --  main project Project. Project is set to No_Project if errors occurred.
  85    --  Current_Dir is for optimization purposes, avoiding extra system calls.
  86    --  If Allow_Duplicate_Basenames, then files with the same base names are
  87    --  authorized within a project for source-based languages (never for unit
  88    --  based languages)
  89
  90    procedure Copy_Package_Declarations
  91      (From              : Declarations;
  92       To                : in out Declarations;
  93       New_Loc           : Source_Ptr;
  94       Naming_Restricted : Boolean;
  95       In_Tree           : Project_Tree_Ref);
  96    --  Copy a package declaration From to To for a renamed package. Change the
  97    --  locations of all the attributes to New_Loc. When Naming_Restricted is
  98    --  True, do not copy attributes Body, Spec, Implementation and
  99    --  Specification.
 100
 101    function Expression
 102      (Project                : Project_Id;
 103       In_Tree                : Project_Tree_Ref;
 104       Flags                  : Processing_Flags;
 105       From_Project_Node      : Project_Node_Id;
 106       From_Project_Node_Tree : Project_Node_Tree_Ref;
 107       Pkg                    : Package_Id;
 108       First_Term             : Project_Node_Id;
 109       Kind                   : Variable_Kind) return Variable_Value;
 110    --  From N_Expression project node From_Project_Node, compute the value
 111    --  of an expression and return it as a Variable_Value.
 112
 113    function Imported_Or_Extended_Project_From
 114      (Project   : Project_Id;
 115       With_Name : Name_Id) return Project_Id;
 116    --  Find an imported or extended project of Project whose name is With_Name
 117
 118    function Package_From
 119      (Project   : Project_Id;
 120       In_Tree   : Project_Tree_Ref;
 121       With_Name : Name_Id) return Package_Id;
 122    --  Find the package of Project whose name is With_Name
 123
 124    procedure Process_Declarative_Items
 125      (Project                : Project_Id;
 126       In_Tree                : Project_Tree_Ref;
 127       Flags                  : Processing_Flags;
 128       From_Project_Node      : Project_Node_Id;
 129       From_Project_Node_Tree : Project_Node_Tree_Ref;
 130       Pkg                    : Package_Id;
 131       Item                   : Project_Node_Id);
 132    --  Process declarative items starting with From_Project_Node, and put them
 133    --  in declarations Decl. This is a recursive procedure; it calls itself for
 134    --  a package declaration or a case construction.
 135
 136    procedure Recursive_Process
 137      (In_Tree                : Project_Tree_Ref;
 138       Project                : out Project_Id;
 139       Flags                  : Processing_Flags;
 140       From_Project_Node      : Project_Node_Id;
 141       From_Project_Node_Tree : Project_Node_Tree_Ref;
 142       Extended_By            : Project_Id);
 143    --  Process project with node From_Project_Node in the tree. Do nothing if
 144    --  From_Project_Node is Empty_Node. If project has already been processed,
 145    --  simply return its project id. Otherwise create a new project id, mark it
 146    --  as processed, call itself recursively for all imported projects and a
 147    --  extended project, if any. Then process the declarative items of the
 148    --  project.
 149
 150    function Get_Attribute_Index
 151      (Tree  : Project_Node_Tree_Ref;
 152       Attr  : Project_Node_Id;
 153       Index : Name_Id) return Name_Id;
 154    --  Copy the index of the attribute into Name_Buffer, converting to lower
 155    --  case if the attribute is case-insensitive.
 156
 157    ---------
 158    -- Add --
 159    ---------
 160
 161    procedure Add (To_Exp : in out Name_Id; Str : Name_Id) is
 162    begin
 163       if To_Exp = No_Name or else To_Exp = Empty_String then
 164
 165          --  To_Exp is nil or empty. The result is Str
 166
 167          To_Exp := Str;
 168
 169       --  If Str is nil, then do not change To_Ext
 170
 171       elsif Str /= No_Name and then Str /= Empty_String then
 172          declare
 173             S : constant String := Get_Name_String (Str);
 174          begin
 175             Get_Name_String (To_Exp);
 176             Add_Str_To_Name_Buffer (S);
 177             To_Exp := Name_Find;
 178          end;
 179       end if;
 180    end Add;
 181
 182    --------------------
 183    -- Add_Attributes --
 184    --------------------
 185
 186    procedure Add_Attributes
 187      (Project       : Project_Id;
 188       Project_Name  : Name_Id;
 189       Project_Dir   : Name_Id;
 190       In_Tree       : Project_Tree_Ref;
 191       Decl          : in out Declarations;
 192       First         : Attribute_Node_Id;
 193       Project_Level : Boolean)
 194    is
 195       The_Attribute  : Attribute_Node_Id := First;
 196
 197    begin
 198       while The_Attribute /= Empty_Attribute loop
 199          if Attribute_Kind_Of (The_Attribute) = Single then
 200             declare
 201                New_Attribute : Variable_Value;
 202
 203             begin
 204                case Variable_Kind_Of (The_Attribute) is
 205
 206                   --  Undefined should not happen
 207
 208                   when Undefined =>
 209                      pragma Assert
 210                        (False, "attribute with an undefined kind");
 211                      raise Program_Error;
 212
 213                   --  Single attributes have a default value of empty string
 214
 215                   when Single =>
 216                      New_Attribute :=
 217                        (Project  => Project,
 218                         Kind     => Single,
 219                         Location => No_Location,
 220                         Default  => True,
 221                         Value    => Empty_String,
 222                         Index    => 0);
 223
 224                      --  Special cases of <project>'Name and
 225                      --  <project>'Project_Dir.
 226
 227                      if Project_Level then
 228                         if Attribute_Name_Of (The_Attribute) =
 229                           Snames.Name_Name
 230                         then
 231                            New_Attribute.Value := Project_Name;
 232
 233                         elsif Attribute_Name_Of (The_Attribute) =
 234                           Snames.Name_Project_Dir
 235                         then
 236                            New_Attribute.Value := Project_Dir;
 237                         end if;
 238                      end if;
 239
 240                   --  List attributes have a default value of nil list
 241
 242                   when List =>
 243                      New_Attribute :=
 244                        (Project  => Project,
 245                         Kind     => List,
 246                         Location => No_Location,
 247                         Default  => True,
 248                         Values   => Nil_String);
 249
 250                end case;
 251
 252                Variable_Element_Table.Increment_Last
 253                  (In_Tree.Variable_Elements);
 254                In_Tree.Variable_Elements.Table
 255                  (Variable_Element_Table.Last
 256                    (In_Tree.Variable_Elements)) :=
 257                  (Next  => Decl.Attributes,
 258                   Name  => Attribute_Name_Of (The_Attribute),
 259                   Value => New_Attribute);
 260                Decl.Attributes := Variable_Element_Table.Last
 261                  (In_Tree.Variable_Elements);
 262             end;
 263          end if;
 264
 265          The_Attribute := Next_Attribute (After => The_Attribute);
 266       end loop;
 267    end Add_Attributes;
 268
 269    -----------
 270    -- Check --
 271    -----------
 272
 273    procedure Check
 274      (In_Tree : Project_Tree_Ref;
 275       Project : Project_Id;
 276       Flags   : Processing_Flags)
 277    is
 278    begin
 279       Process_Naming_Scheme (In_Tree, Project, Flags);
 280
 281       --  Set the Other_Part field for the units
 282
 283       declare
 284          Source1 : Source_Id;
 285          Name    : Name_Id;
 286          Source2 : Source_Id;
 287          Iter    : Source_Iterator;
 288
 289       begin
 290          Unit_Htable.Reset;
 291
 292          Iter := For_Each_Source (In_Tree);
 293          loop
 294             Source1 := Prj.Element (Iter);
 295             exit when Source1 = No_Source;
 296
 297             if Source1.Unit /= No_Unit_Index then
 298                Name := Source1.Unit.Name;
 299                Source2 := Unit_Htable.Get (Name);
 300
 301                if Source2 = No_Source then
 302                   Unit_Htable.Set (K => Name, E => Source1);
 303                else
 304                   Unit_Htable.Remove (Name);
 305                end if;
 306             end if;
 307
 308             Next (Iter);
 309          end loop;
 310       end;
 311    end Check;
 312
 313    -------------------------------
 314    -- Copy_Package_Declarations --
 315    -------------------------------
 316
 317    procedure Copy_Package_Declarations
 318      (From              : Declarations;
 319       To                : in out Declarations;
 320       New_Loc           : Source_Ptr;
 321       Naming_Restricted : Boolean;
 322       In_Tree           : Project_Tree_Ref)
 323    is
 324       V1  : Variable_Id;
 325       V2  : Variable_Id      := No_Variable;
 326       Var : Variable;
 327       A1  : Array_Id;
 328       A2  : Array_Id         := No_Array;
 329       Arr : Array_Data;
 330       E1  : Array_Element_Id;
 331       E2  : Array_Element_Id := No_Array_Element;
 332       Elm : Array_Element;
 333
 334    begin
 335       --  To avoid references in error messages to attribute declarations in
 336       --  an original package that has been renamed, copy all the attribute
 337       --  declarations of the package and change all locations to New_Loc,
 338       --  the location of the renamed package.
 339
 340       --  First single attributes
 341
 342       V1 := From.Attributes;
 343       while V1 /= No_Variable loop
 344
 345          --  Copy the attribute
 346
 347          Var := In_Tree.Variable_Elements.Table (V1);
 348          V1  := Var.Next;
 349
 350          --  Remove the Next component
 351
 352          Var.Next := No_Variable;
 353
 354          --  Change the location to New_Loc
 355
 356          Var.Value.Location := New_Loc;
 357          Variable_Element_Table.Increment_Last (In_Tree.Variable_Elements);
 358
 359          --  Put in new declaration
 360
 361          if To.Attributes = No_Variable then
 362             To.Attributes :=
 363               Variable_Element_Table.Last (In_Tree.Variable_Elements);
 364          else
 365             In_Tree.Variable_Elements.Table (V2).Next :=
 366               Variable_Element_Table.Last (In_Tree.Variable_Elements);
 367          end if;
 368
 369          V2 := Variable_Element_Table.Last (In_Tree.Variable_Elements);
 370          In_Tree.Variable_Elements.Table (V2) := Var;
 371       end loop;
 372
 373       --  Then the associated array attributes
 374
 375       A1 := From.Arrays;
 376       while A1 /= No_Array loop
 377          Arr := In_Tree.Arrays.Table (A1);
 378          A1  := Arr.Next;
 379
 380          if not Naming_Restricted or else
 381            (Arr.Name /= Snames.Name_Body
 382              and then Arr.Name /= Snames.Name_Spec
 383              and then Arr.Name /= Snames.Name_Implementation
 384              and then Arr.Name /= Snames.Name_Specification)
 385          then
 386             --  Remove the Next component
 387
 388             Arr.Next := No_Array;
 389
 390             Array_Table.Increment_Last (In_Tree.Arrays);
 391
 392             --  Create new Array declaration
 393
 394             if To.Arrays = No_Array then
 395                To.Arrays := Array_Table.Last (In_Tree.Arrays);
 396             else
 397                In_Tree.Arrays.Table (A2).Next :=
 398                  Array_Table.Last (In_Tree.Arrays);
 399             end if;
 400
 401             A2 := Array_Table.Last (In_Tree.Arrays);
 402
 403             --  Don't store the array as its first element has not been set yet
 404
 405             --  Copy the array elements of the array
 406
 407             E1 := Arr.Value;
 408             Arr.Value := No_Array_Element;
 409             while E1 /= No_Array_Element loop
 410
 411                --  Copy the array element
 412
 413                Elm := In_Tree.Array_Elements.Table (E1);
 414                E1 := Elm.Next;
 415
 416                --  Remove the Next component
 417
 418                Elm.Next := No_Array_Element;
 419
 420                --  Change the location
 421
 422                Elm.Value.Location := New_Loc;
 423                Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
 424
 425                --  Create new array element
 426
 427                if Arr.Value = No_Array_Element then
 428                   Arr.Value :=
 429                     Array_Element_Table.Last (In_Tree.Array_Elements);
 430                else
 431                   In_Tree.Array_Elements.Table (E2).Next :=
 432                     Array_Element_Table.Last (In_Tree.Array_Elements);
 433                end if;
 434
 435                E2 := Array_Element_Table.Last (In_Tree.Array_Elements);
 436                In_Tree.Array_Elements.Table (E2) := Elm;
 437             end loop;
 438
 439             --  Finally, store the new array
 440
 441             In_Tree.Arrays.Table (A2) := Arr;
 442          end if;
 443       end loop;
 444    end Copy_Package_Declarations;
 445
 446    -------------------------
 447    -- Get_Attribute_Index --
 448    -------------------------
 449
 450    function Get_Attribute_Index
 451      (Tree  : Project_Node_Tree_Ref;
 452       Attr  : Project_Node_Id;
 453       Index : Name_Id) return Name_Id
 454    is
 455       Lower : Boolean;
 456
 457    begin
 458       Get_Name_String (Index);
 459       Lower := Case_Insensitive (Attr, Tree);
 460
 461       --  The index is always case insensitive if it does not include any dot.
 462       --  ??? Why not use the properties from prj-attr, simply, maybe because
 463       --  we don't know whether we have a file as an index?
 464
 465       if not Lower then
 466          Lower := True;
 467
 468          for J in 1 .. Name_Len loop
 469             if Name_Buffer (J) = '.' then
 470                Lower := False;
 471                exit;
 472             end if;
 473          end loop;
 474       end if;
 475
 476       if Lower then
 477          To_Lower (Name_Buffer (1 .. Name_Len));
 478          return Name_Find;
 479       else
 480          return Index;
 481       end if;
 482    end Get_Attribute_Index;
 483
 484    ----------------
 485    -- Expression --
 486    ----------------
 487
 488    function Expression
 489      (Project                : Project_Id;
 490       In_Tree                : Project_Tree_Ref;
 491       Flags                  : Processing_Flags;
 492       From_Project_Node      : Project_Node_Id;
 493       From_Project_Node_Tree : Project_Node_Tree_Ref;
 494       Pkg                    : Package_Id;
 495       First_Term             : Project_Node_Id;
 496       Kind                   : Variable_Kind) return Variable_Value
 497    is
 498       The_Term : Project_Node_Id;
 499       --  The term in the expression list
 500
 501       The_Current_Term : Project_Node_Id := Empty_Node;
 502       --  The current term node id
 503
 504       Result : Variable_Value (Kind => Kind);
 505       --  The returned result
 506
 507       Last : String_List_Id := Nil_String;
 508       --  Reference to the last string elements in Result, when Kind is List
 509
 510    begin
 511       Result.Project := Project;
 512       Result.Location := Location_Of (First_Term, From_Project_Node_Tree);
 513
 514       --  Process each term of the expression, starting with First_Term
 515
 516       The_Term := First_Term;
 517       while Present (The_Term) loop
 518          The_Current_Term := Current_Term (The_Term, From_Project_Node_Tree);
 519
 520          case Kind_Of (The_Current_Term, From_Project_Node_Tree) is
 521
 522             when N_Literal_String =>
 523
 524                case Kind is
 525
 526                   when Undefined =>
 527
 528                      --  Should never happen
 529
 530                      pragma Assert (False, "Undefined expression kind");
 531                      raise Program_Error;
 532
 533                   when Single =>
 534                      Add (Result.Value,
 535                           String_Value_Of
 536                             (The_Current_Term, From_Project_Node_Tree));
 537                      Result.Index :=
 538                        Source_Index_Of
 539                          (The_Current_Term, From_Project_Node_Tree);
 540
 541                   when List =>
 542
 543                      String_Element_Table.Increment_Last
 544                        (In_Tree.String_Elements);
 545
 546                      if Last = Nil_String then
 547
 548                         --  This can happen in an expression like () & "toto"
 549
 550                         Result.Values := String_Element_Table.Last
 551                           (In_Tree.String_Elements);
 552
 553                      else
 554                         In_Tree.String_Elements.Table
 555                           (Last).Next := String_Element_Table.Last
 556                                        (In_Tree.String_Elements);
 557                      end if;
 558
 559                      Last := String_Element_Table.Last
 560                                (In_Tree.String_Elements);
 561
 562                      In_Tree.String_Elements.Table (Last) :=
 563                        (Value         => String_Value_Of
 564                                            (The_Current_Term,
 565                                             From_Project_Node_Tree),
 566                         Index         => Source_Index_Of
 567                                            (The_Current_Term,
 568                                             From_Project_Node_Tree),
 569                         Display_Value => No_Name,
 570                         Location      => Location_Of
 571                                            (The_Current_Term,
 572                                             From_Project_Node_Tree),
 573                         Flag          => False,
 574                         Next          => Nil_String);
 575                end case;
 576
 577             when N_Literal_String_List =>
 578
 579                declare
 580                   String_Node : Project_Node_Id :=
 581                                   First_Expression_In_List
 582                                     (The_Current_Term,
 583                                      From_Project_Node_Tree);
 584
 585                   Value : Variable_Value;
 586
 587                begin
 588                   if Present (String_Node) then
 589
 590                      --  If String_Node is nil, it is an empty list, there is
 591                      --  nothing to do
 592
 593                      Value := Expression
 594                        (Project                => Project,
 595                         In_Tree                => In_Tree,
 596                         Flags                  => Flags,
 597                         From_Project_Node      => From_Project_Node,
 598                         From_Project_Node_Tree => From_Project_Node_Tree,
 599                         Pkg                    => Pkg,
 600                         First_Term             =>
 601                           Tree.First_Term
 602                             (String_Node, From_Project_Node_Tree),
 603                         Kind                   => Single);
 604                      String_Element_Table.Increment_Last
 605                        (In_Tree.String_Elements);
 606
 607                      if Result.Values = Nil_String then
 608
 609                         --  This literal string list is the first term in a
 610                         --  string list expression
 611
 612                         Result.Values :=
 613                           String_Element_Table.Last (In_Tree.String_Elements);
 614
 615                      else
 616                         In_Tree.String_Elements.Table
 617                           (Last).Next :=
 618                           String_Element_Table.Last (In_Tree.String_Elements);
 619                      end if;
 620
 621                      Last :=
 622                        String_Element_Table.Last (In_Tree.String_Elements);
 623
 624                      In_Tree.String_Elements.Table (Last) :=
 625                        (Value    => Value.Value,
 626                         Display_Value => No_Name,
 627                         Location => Value.Location,
 628                         Flag     => False,
 629                         Next     => Nil_String,
 630                         Index    => Value.Index);
 631
 632                      loop
 633                         --  Add the other element of the literal string list
 634                         --  one after the other
 635
 636                         String_Node :=
 637                           Next_Expression_In_List
 638                             (String_Node, From_Project_Node_Tree);
 639
 640                         exit when No (String_Node);
 641
 642                         Value :=
 643                           Expression
 644                             (Project                => Project,
 645                              In_Tree                => In_Tree,
 646                              Flags                  => Flags,
 647                              From_Project_Node      => From_Project_Node,
 648                              From_Project_Node_Tree => From_Project_Node_Tree,
 649                              Pkg                    => Pkg,
 650                              First_Term             =>
 651                                Tree.First_Term
 652                                  (String_Node, From_Project_Node_Tree),
 653                              Kind                   => Single);
 654
 655                         String_Element_Table.Increment_Last
 656                           (In_Tree.String_Elements);
 657                         In_Tree.String_Elements.Table
 658                           (Last).Next := String_Element_Table.Last
 659                                         (In_Tree.String_Elements);
 660                         Last := String_Element_Table.Last
 661                           (In_Tree.String_Elements);
 662                         In_Tree.String_Elements.Table (Last) :=
 663                           (Value    => Value.Value,
 664                            Display_Value => No_Name,
 665                            Location => Value.Location,
 666                            Flag     => False,
 667                            Next     => Nil_String,
 668                            Index    => Value.Index);
 669                      end loop;
 670                   end if;
 671                end;
 672
 673             when N_Variable_Reference | N_Attribute_Reference =>
 674
 675                declare
 676                   The_Project     : Project_Id  := Project;
 677                   The_Package     : Package_Id  := Pkg;
 678                   The_Name        : Name_Id     := No_Name;
 679                   The_Variable_Id : Variable_Id := No_Variable;
 680                   The_Variable    : Variable_Value;
 681                   Term_Project    : constant Project_Node_Id :=
 682                                       Project_Node_Of
 683                                         (The_Current_Term,
 684                                          From_Project_Node_Tree);
 685                   Term_Package    : constant Project_Node_Id :=
 686                                       Package_Node_Of
 687                                         (The_Current_Term,
 688                                          From_Project_Node_Tree);
 689                   Index           : Name_Id := No_Name;
 690
 691                begin
 692                   if Present (Term_Project) and then
 693                      Term_Project /= From_Project_Node
 694                   then
 695                      --  This variable or attribute comes from another project
 696
 697                      The_Name :=
 698                        Name_Of (Term_Project, From_Project_Node_Tree);
 699                      The_Project := Imported_Or_Extended_Project_From
 700                                       (Project   => Project,
 701                                        With_Name => The_Name);
 702                   end if;
 703
 704                   if Present (Term_Package) then
 705
 706                      --  This is an attribute of a package
 707
 708                      The_Name :=
 709                        Name_Of (Term_Package, From_Project_Node_Tree);
 710                      The_Package := The_Project.Decl.Packages;
 711
 712                      while The_Package /= No_Package
 713                        and then In_Tree.Packages.Table
 714                                   (The_Package).Name /= The_Name
 715                      loop
 716                         The_Package :=
 717                           In_Tree.Packages.Table
 718                             (The_Package).Next;
 719                      end loop;
 720
 721                      pragma Assert
 722                        (The_Package /= No_Package,
 723                         "package not found.");
 724
 725                   elsif Kind_Of (The_Current_Term, From_Project_Node_Tree) =
 726                           N_Attribute_Reference
 727                   then
 728                      The_Package := No_Package;
 729                   end if;
 730
 731                   The_Name :=
 732                     Name_Of (The_Current_Term, From_Project_Node_Tree);
 733
 734                   if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
 735                        N_Attribute_Reference
 736                   then
 737                      Index :=
 738                        Associative_Array_Index_Of
 739                          (The_Current_Term, From_Project_Node_Tree);
 740                   end if;
 741
 742                   --  If it is not an associative array attribute
 743
 744                   if Index = No_Name then
 745
 746                      --  It is not an associative array attribute
 747
 748                      if The_Package /= No_Package then
 749
 750                         --  First, if there is a package, look into the package
 751
 752                         if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
 753                              N_Variable_Reference
 754                         then
 755                            The_Variable_Id :=
 756                              In_Tree.Packages.Table
 757                                (The_Package).Decl.Variables;
 758                         else
 759                            The_Variable_Id :=
 760                              In_Tree.Packages.Table
 761                                (The_Package).Decl.Attributes;
 762                         end if;
 763
 764                         while The_Variable_Id /= No_Variable
 765                           and then
 766                             In_Tree.Variable_Elements.Table
 767                               (The_Variable_Id).Name /= The_Name
 768                         loop
 769                            The_Variable_Id :=
 770                              In_Tree.Variable_Elements.Table
 771                                (The_Variable_Id).Next;
 772                         end loop;
 773
 774                      end if;
 775
 776                      if The_Variable_Id = No_Variable then
 777
 778                         --  If we have not found it, look into the project
 779
 780                         if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
 781                              N_Variable_Reference
 782                         then
 783                            The_Variable_Id := The_Project.Decl.Variables;
 784                         else
 785                            The_Variable_Id := The_Project.Decl.Attributes;
 786                         end if;
 787
 788                         while The_Variable_Id /= No_Variable
 789                           and then
 790                           In_Tree.Variable_Elements.Table
 791                             (The_Variable_Id).Name /= The_Name
 792                         loop
 793                            The_Variable_Id :=
 794                              In_Tree.Variable_Elements.Table
 795                                (The_Variable_Id).Next;
 796                         end loop;
 797
 798                      end if;
 799
 800                      pragma Assert (The_Variable_Id /= No_Variable,
 801                                       "variable or attribute not found");
 802
 803                      The_Variable :=
 804                        In_Tree.Variable_Elements.Table
 805                                                     (The_Variable_Id).Value;
 806
 807                   else
 808
 809                      --  It is an associative array attribute
 810
 811                      declare
 812                         The_Array   : Array_Id := No_Array;
 813                         The_Element : Array_Element_Id := No_Array_Element;
 814                         Array_Index : Name_Id := No_Name;
 815
 816                      begin
 817                         if The_Package /= No_Package then
 818                            The_Array :=
 819                              In_Tree.Packages.Table
 820                                (The_Package).Decl.Arrays;
 821                         else
 822                            The_Array := The_Project.Decl.Arrays;
 823                         end if;
 824
 825                         while The_Array /= No_Array
 826                           and then In_Tree.Arrays.Table
 827                                      (The_Array).Name /= The_Name
 828                         loop
 829                            The_Array := In_Tree.Arrays.Table
 830                                           (The_Array).Next;
 831                         end loop;
 832
 833                         if The_Array /= No_Array then
 834                            The_Element := In_Tree.Arrays.Table
 835                                             (The_Array).Value;
 836                            Array_Index :=
 837                              Get_Attribute_Index
 838                                (From_Project_Node_Tree,
 839                                 The_Current_Term,
 840                                 Index);
 841
 842                            while The_Element /= No_Array_Element
 843                              and then
 844                              In_Tree.Array_Elements.Table
 845                                (The_Element).Index /= Array_Index
 846                            loop
 847                               The_Element :=
 848                                 In_Tree.Array_Elements.Table
 849                                   (The_Element).Next;
 850                            end loop;
 851
 852                         end if;
 853
 854                         if The_Element /= No_Array_Element then
 855                            The_Variable :=
 856                              In_Tree.Array_Elements.Table
 857                                (The_Element).Value;
 858
 859                         else
 860                            if Expression_Kind_Of
 861                              (The_Current_Term, From_Project_Node_Tree) =
 862                                                                         List
 863                            then
 864                               The_Variable :=
 865                                 (Project  => Project,
 866                                  Kind     => List,
 867                                  Location => No_Location,
 868                                  Default  => True,
 869                                  Values   => Nil_String);
 870                            else
 871                               The_Variable :=
 872                                 (Project  => Project,
 873                                  Kind     => Single,
 874                                  Location => No_Location,
 875                                  Default  => True,
 876                                  Value    => Empty_String,
 877                                  Index    => 0);
 878                            end if;
 879                         end if;
 880                      end;
 881                   end if;
 882
 883                   case Kind is
 884
 885                      when Undefined =>
 886
 887                         --  Should never happen
 888
 889                         pragma Assert (False, "undefined expression kind");
 890                         null;
 891
 892                      when Single =>
 893
 894                         case The_Variable.Kind is
 895
 896                            when Undefined =>
 897                               null;
 898
 899                            when Single =>
 900                               Add (Result.Value, The_Variable.Value);
 901
 902                            when List =>
 903
 904                               --  Should never happen
 905
 906                               pragma Assert
 907                                 (False,
 908                                  "list cannot appear in single " &
 909                                  "string expression");
 910                               null;
 911                         end case;
 912
 913                      when List =>
 914                         case The_Variable.Kind is
 915
 916                            when Undefined =>
 917                               null;
 918
 919                            when Single =>
 920                               String_Element_Table.Increment_Last
 921                                 (In_Tree.String_Elements);
 922
 923                               if Last = Nil_String then
 924
 925                                  --  This can happen in an expression such as
 926                                  --  () & Var
 927
 928                                  Result.Values :=
 929                                    String_Element_Table.Last
 930                                      (In_Tree.String_Elements);
 931
 932                               else
 933                                  In_Tree.String_Elements.Table
 934                                    (Last).Next :=
 935                                      String_Element_Table.Last
 936                                        (In_Tree.String_Elements);
 937                               end if;
 938
 939                               Last :=
 940                                 String_Element_Table.Last
 941                                   (In_Tree.String_Elements);
 942
 943                               In_Tree.String_Elements.Table (Last) :=
 944                                 (Value         => The_Variable.Value,
 945                                  Display_Value => No_Name,
 946                                  Location      => Location_Of
 947                                                     (The_Current_Term,
 948                                                      From_Project_Node_Tree),
 949                                  Flag          => False,
 950                                  Next          => Nil_String,
 951                                  Index         => 0);
 952
 953                            when List =>
 954
 955                               declare
 956                                  The_List : String_List_Id :=
 957                                               The_Variable.Values;
 958
 959                               begin
 960                                  while The_List /= Nil_String loop
 961                                     String_Element_Table.Increment_Last
 962                                       (In_Tree.String_Elements);
 963
 964                                     if Last = Nil_String then
 965                                        Result.Values :=
 966                                          String_Element_Table.Last
 967                                            (In_Tree.
 968                                                 String_Elements);
 969
 970                                     else
 971                                        In_Tree.
 972                                          String_Elements.Table (Last).Next :=
 973                                          String_Element_Table.Last
 974                                            (In_Tree.
 975                                                 String_Elements);
 976
 977                                     end if;
 978
 979                                     Last :=
 980                                       String_Element_Table.Last
 981                                         (In_Tree.String_Elements);
 982
 983                                     In_Tree.String_Elements.Table (Last) :=
 984                                       (Value         =>
 985                                          In_Tree.String_Elements.Table
 986                                            (The_List).Value,
 987                                        Display_Value => No_Name,
 988                                        Location      =>
 989                                          Location_Of
 990                                            (The_Current_Term,
 991                                             From_Project_Node_Tree),
 992                                        Flag         => False,
 993                                        Next         => Nil_String,
 994                                        Index        => 0);
 995
 996                                     The_List :=
 997                                       In_Tree. String_Elements.Table
 998                                         (The_List).Next;
 999                                  end loop;
1000                               end;
1001                         end case;
1002                   end case;
1003                end;
1004
1005             when N_External_Value =>
1006                Get_Name_String
1007                  (String_Value_Of
1008                     (External_Reference_Of
1009                        (The_Current_Term, From_Project_Node_Tree),
1010                      From_Project_Node_Tree));
1011
1012                declare
1013                   Name    : constant Name_Id  := Name_Find;
1014                   Default : Name_Id           := No_Name;
1015                   Value   : Name_Id           := No_Name;
1016
1017                   Def_Var : Variable_Value;
1018
1019                   Default_Node : constant Project_Node_Id :=
1020                     External_Default_Of
1021                       (The_Current_Term, From_Project_Node_Tree);
1022
1023                begin
1024                   --  If there is a default value for the external reference,
1025                   --  get its value.
1026
1027                   if Present (Default_Node) then
1028                      Def_Var := Expression
1029                        (Project                => Project,
1030                         In_Tree                => In_Tree,
1031                         Flags                  => Flags,
1032                         From_Project_Node      => From_Project_Node,
1033                         From_Project_Node_Tree => From_Project_Node_Tree,
1034                         Pkg                    => Pkg,
1035                         First_Term             =>
1036                           Tree.First_Term
1037                             (Default_Node, From_Project_Node_Tree),
1038                         Kind                   => Single);
1039
1040                      if Def_Var /= Nil_Variable_Value then
1041                         Default := Def_Var.Value;
1042                      end if;
1043                   end if;
1044
1045                   Value := Prj.Ext.Value_Of (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 the object
2260       --  directory of all virtual extending projects to the object
2261       --  directory of the main project.
2262
2263       if Project /= No_Project
2264         and then
2265           Is_Extending_All (From_Project_Node, From_Project_Node_Tree)
2266       then
2267          declare
2268             Object_Dir : constant Path_Name_Type :=
2269                            Project.Object_Directory.Name;
2270          begin
2271             Prj := In_Tree.Projects;
2272             while Prj /= null loop
2273                if Prj.Project.Virtual then
2274                   Prj.Project.Object_Directory.Name := Object_Dir;
2275                end if;
2276                Prj := Prj.Next;
2277             end loop;
2278          end;
2279       end if;
2280
2281       --  Check that no extending project shares its object directory with
2282       --  the project(s) it extends.
2283
2284       if Project /= No_Project then
2285          Prj := In_Tree.Projects;
2286          while Prj /= null loop
2287             Extending := Prj.Project.Extended_By;
2288
2289             if Extending /= No_Project then
2290                Obj_Dir := Prj.Project.Object_Directory.Name;
2291
2292                --  Check that a project being extended does not share its
2293                --  object directory with any project that extends it, directly
2294                --  or indirectly, including a virtual extending project.
2295
2296                --  Start with the project directly extending it
2297
2298                Extending2 := Extending;
2299                while Extending2 /= No_Project loop
2300                   if Has_Ada_Sources (Extending2)
2301                     and then Extending2.Object_Directory.Name = Obj_Dir
2302                   then
2303                      if Extending2.Virtual then
2304                         Error_Msg_Name_1 := Prj.Project.Display_Name;
2305                         Error_Msg
2306                           (Flags,
2307                            "project %% cannot be extended by a virtual" &
2308                            " project with the same object directory",
2309                            Prj.Project.Location, Project);
2310
2311                      else
2312                         Error_Msg_Name_1 := Extending2.Display_Name;
2313                         Error_Msg_Name_2 := Prj.Project.Display_Name;
2314                         Error_Msg
2315                           (Flags,
2316                            "project %% cannot extend project %%",
2317                            Extending2.Location, Project);
2318                         Error_Msg
2319                           (Flags,
2320                            "\they share the same object directory",
2321                            Extending2.Location, Project);
2322                      end if;
2323                   end if;
2324
2325                   --  Continue with the next extending project, if any
2326
2327                   Extending2 := Extending2.Extended_By;
2328                end loop;
2329             end if;
2330
2331             Prj := Prj.Next;
2332          end loop;
2333       end if;
2334
2335       Success :=
2336         Total_Errors_Detected = 0
2337           and then
2338             (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
2339    end Process_Project_Tree_Phase_2;
2340
2341    -----------------------
2342    -- Recursive_Process --
2343    -----------------------
2344
2345    procedure Recursive_Process
2346      (In_Tree                : Project_Tree_Ref;
2347       Project                : out Project_Id;
2348       Flags                  : Processing_Flags;
2349       From_Project_Node      : Project_Node_Id;
2350       From_Project_Node_Tree : Project_Node_Tree_Ref;
2351       Extended_By            : Project_Id)
2352    is
2353       procedure Process_Imported_Projects
2354         (Imported     : in out Project_List;
2355          Limited_With : Boolean);
2356       --  Process imported projects. If Limited_With is True, then only
2357       --  projects processed through a "limited with" are processed, otherwise
2358       --  only projects imported through a standard "with" are processed.
2359       --  Imported is the id of the last imported project.
2360
2361       -------------------------------
2362       -- Process_Imported_Projects --
2363       -------------------------------
2364
2365       procedure Process_Imported_Projects
2366         (Imported     : in out Project_List;
2367          Limited_With : Boolean)
2368       is
2369          With_Clause : Project_Node_Id;
2370          New_Project : Project_Id;
2371          Proj_Node   : Project_Node_Id;
2372
2373       begin
2374          With_Clause :=
2375            First_With_Clause_Of
2376              (From_Project_Node, From_Project_Node_Tree);
2377          while Present (With_Clause) loop
2378             Proj_Node :=
2379               Non_Limited_Project_Node_Of
2380                 (With_Clause, From_Project_Node_Tree);
2381             New_Project := No_Project;
2382
2383             if (Limited_With and No (Proj_Node))
2384               or (not Limited_With and Present (Proj_Node))
2385             then
2386                Recursive_Process
2387                  (In_Tree                => In_Tree,
2388                   Project                => New_Project,
2389                   Flags                  => Flags,
2390                   From_Project_Node      =>
2391                     Project_Node_Of
2392                       (With_Clause, From_Project_Node_Tree),
2393                   From_Project_Node_Tree => From_Project_Node_Tree,
2394                   Extended_By            => No_Project);
2395
2396                --  Imported is the id of the last imported project. If
2397                --  it is nil, then this imported project is our first.
2398
2399                if Imported = null then
2400                   Project.Imported_Projects :=
2401                     new Project_List_Element'
2402                       (Project => New_Project,
2403                        Next    => null);
2404                   Imported := Project.Imported_Projects;
2405                else
2406                   Imported.Next := new Project_List_Element'
2407                     (Project => New_Project,
2408                      Next    => null);
2409                   Imported := Imported.Next;
2410                end if;
2411             end if;
2412
2413             With_Clause :=
2414               Next_With_Clause_Of (With_Clause, From_Project_Node_Tree);
2415          end loop;
2416       end Process_Imported_Projects;
2417
2418    --  Start of processing for Recursive_Process
2419
2420    begin
2421       if No (From_Project_Node) then
2422          Project := No_Project;
2423
2424       else
2425          declare
2426             Imported         : Project_List;
2427             Declaration_Node : Project_Node_Id  := Empty_Node;
2428             Tref             : Source_Buffer_Ptr;
2429             Name             : constant Name_Id :=
2430                                  Name_Of
2431                                    (From_Project_Node, From_Project_Node_Tree);
2432             Location         : Source_Ptr :=
2433                                  Location_Of
2434                                    (From_Project_Node, From_Project_Node_Tree);
2435
2436          begin
2437             Project := Processed_Projects.Get (Name);
2438
2439             if Project /= No_Project then
2440
2441                --  Make sure that, when a project is extended, the project id
2442                --  of the project extending it is recorded in its data, even
2443                --  when it has already been processed as an imported project.
2444                --  This is for virtually extended projects.
2445
2446                if Extended_By /= No_Project then
2447                   Project.Extended_By := Extended_By;
2448                end if;
2449
2450                return;
2451             end if;
2452
2453             Project := new Project_Data'(Empty_Project);
2454             In_Tree.Projects := new Project_List_Element'
2455               (Project => Project,
2456                Next    => In_Tree.Projects);
2457
2458             Processed_Projects.Set (Name, Project);
2459
2460             Project.Name := 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                Project.Display_Name := Name;
2475
2476             --  If there is no file, for example when the project node tree is
2477             --  built in memory by GPS, the Display_Name cannot be found in
2478             --  the source, so its value is the same as Name.
2479
2480             elsif Location = No_Location then
2481                Project.Display_Name := Name;
2482
2483             --  Get the spelling of the project name from the project file
2484
2485             else
2486                Tref := Source_Text (Get_Source_File_Index (Location));
2487
2488                for J in 1 .. Name_Len loop
2489                   Name_Buffer (J) := Tref (Location);
2490                   Location := Location + 1;
2491                end loop;
2492
2493                Project.Display_Name := Name_Find;
2494             end if;
2495
2496             Project.Path.Display_Name :=
2497               Path_Name_Of (From_Project_Node, From_Project_Node_Tree);
2498             Get_Name_String (Project.Path.Display_Name);
2499             Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2500             Project.Path.Name := Name_Find;
2501
2502             Project.Location :=
2503               Location_Of (From_Project_Node, From_Project_Node_Tree);
2504
2505             Project.Directory.Display_Name :=
2506               Directory_Of (From_Project_Node, From_Project_Node_Tree);
2507             Get_Name_String (Project.Directory.Display_Name);
2508             Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2509             Project.Directory.Name := Name_Find;
2510
2511             Project.Extended_By := Extended_By;
2512
2513             Add_Attributes
2514               (Project,
2515                Name,
2516                Name_Id (Project.Directory.Name),
2517                In_Tree,
2518                Project.Decl,
2519                Prj.Attr.Attribute_First,
2520                Project_Level => True);
2521
2522             Process_Imported_Projects (Imported, Limited_With => False);
2523
2524             Declaration_Node :=
2525               Project_Declaration_Of
2526                 (From_Project_Node, From_Project_Node_Tree);
2527
2528             Recursive_Process
2529               (In_Tree                => In_Tree,
2530                Project                => Project.Extends,
2531                Flags                  => Flags,
2532                From_Project_Node      => Extended_Project_Of
2533                                           (Declaration_Node,
2534                                            From_Project_Node_Tree),
2535                From_Project_Node_Tree => From_Project_Node_Tree,
2536                Extended_By            => Project);
2537
2538             Process_Declarative_Items
2539               (Project                => Project,
2540                In_Tree                => In_Tree,
2541                Flags                  => Flags,
2542                From_Project_Node      => From_Project_Node,
2543                From_Project_Node_Tree => From_Project_Node_Tree,
2544                Pkg                    => No_Package,
2545                Item                   => First_Declarative_Item_Of
2546                                           (Declaration_Node,
2547                                            From_Project_Node_Tree));
2548
2549             --  If it is an extending project, inherit all packages
2550             --  from the extended project that are not explicitly defined
2551             --  or renamed. Also inherit the languages, if attribute Languages
2552             --  is not explicitly defined.
2553
2554             if Project.Extends /= No_Project then
2555                declare
2556                   Extended_Pkg : Package_Id;
2557                   Current_Pkg  : Package_Id;
2558                   Element      : Package_Element;
2559                   First        : constant Package_Id :=
2560                                    Project.Decl.Packages;
2561                   Attribute1   : Variable_Id;
2562                   Attribute2   : Variable_Id;
2563                   Attr_Value1  : Variable;
2564                   Attr_Value2  : Variable;
2565
2566                begin
2567                   Extended_Pkg := Project.Extends.Decl.Packages;
2568                   while Extended_Pkg /= No_Package loop
2569                      Element := In_Tree.Packages.Table (Extended_Pkg);
2570
2571                      Current_Pkg := First;
2572                      while Current_Pkg /= No_Package
2573                        and then In_Tree.Packages.Table (Current_Pkg).Name /=
2574                                                                  Element.Name
2575                      loop
2576                         Current_Pkg :=
2577                           In_Tree.Packages.Table (Current_Pkg).Next;
2578                      end loop;
2579
2580                      if Current_Pkg = No_Package then
2581                         Package_Table.Increment_Last
2582                           (In_Tree.Packages);
2583                         Current_Pkg := Package_Table.Last (In_Tree.Packages);
2584                         In_Tree.Packages.Table (Current_Pkg) :=
2585                           (Name   => Element.Name,
2586                            Decl   => No_Declarations,
2587                            Parent => No_Package,
2588                            Next   => Project.Decl.Packages);
2589                         Project.Decl.Packages := Current_Pkg;
2590                         Copy_Package_Declarations
2591                           (From              => Element.Decl,
2592                            To                =>
2593                              In_Tree.Packages.Table (Current_Pkg).Decl,
2594                            New_Loc           => No_Location,
2595                            Naming_Restricted =>
2596                              Element.Name = Snames.Name_Naming,
2597                            In_Tree           => In_Tree);
2598                      end if;
2599
2600                      Extended_Pkg := Element.Next;
2601                   end loop;
2602
2603                   --  Check if attribute Languages is declared in the
2604                   --  extending project.
2605
2606                   Attribute1 := Project.Decl.Attributes;
2607                   while Attribute1 /= No_Variable loop
2608                      Attr_Value1 := In_Tree.Variable_Elements.
2609                                       Table (Attribute1);
2610                      exit when Attr_Value1.Name = Snames.Name_Languages;
2611                      Attribute1 := Attr_Value1.Next;
2612                   end loop;
2613
2614                   if Attribute1 = No_Variable or else
2615                      Attr_Value1.Value.Default
2616                   then
2617                      --  Attribute Languages is not declared in the extending
2618                      --  project. Check if it is declared in the project being
2619                      --  extended.
2620
2621                      Attribute2 := Project.Extends.Decl.Attributes;
2622                      while Attribute2 /= No_Variable loop
2623                         Attr_Value2 := In_Tree.Variable_Elements.
2624                                          Table (Attribute2);
2625                         exit when Attr_Value2.Name = Snames.Name_Languages;
2626                         Attribute2 := Attr_Value2.Next;
2627                      end loop;
2628
2629                      if Attribute2 /= No_Variable and then
2630                         not Attr_Value2.Value.Default
2631                      then
2632                         --  As attribute Languages is declared in the project
2633                         --  being extended, copy its value for the extending
2634                         --  project.
2635
2636                         if Attribute1 = No_Variable then
2637                            Variable_Element_Table.Increment_Last
2638                              (In_Tree.Variable_Elements);
2639                            Attribute1 := Variable_Element_Table.Last
2640                              (In_Tree.Variable_Elements);
2641                            Attr_Value1.Next := Project.Decl.Attributes;
2642                            Project.Decl.Attributes := Attribute1;
2643                         end if;
2644
2645                         Attr_Value1.Name := Snames.Name_Languages;
2646                         Attr_Value1.Value := Attr_Value2.Value;
2647                         In_Tree.Variable_Elements.Table
2648                           (Attribute1) := Attr_Value1;
2649                      end if;
2650                   end if;
2651                end;
2652             end if;
2653
2654             Process_Imported_Projects (Imported, Limited_With => True);
2655          end;
2656       end if;
2657    end Recursive_Process;
2658
2659 end Prj.Proc;