gcc/ada/prj-proc.adb

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