gcc/ada/prj-proc.adb

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