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