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