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;      use 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 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 :=
1272         Total_Errors_Detected = 0
1273           and then
1274             (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
1275    end Process;
1276
1277    -------------------------------
1278    -- Process_Declarative_Items --
1279    -------------------------------
1280
1281    procedure Process_Declarative_Items
1282      (Project                : Project_Id;
1283       In_Tree                : Project_Tree_Ref;
1284       From_Project_Node      : Project_Node_Id;
1285       From_Project_Node_Tree : Project_Node_Tree_Ref;
1286       Pkg                    : Package_Id;
1287       Item                   : Project_Node_Id)
1288    is
1289       Current_Declarative_Item : Project_Node_Id := Item;
1290       Current_Item             : Project_Node_Id := Empty_Node;
1291
1292    begin
1293       --  For each declarative item
1294
1295       while Current_Declarative_Item /= Empty_Node loop
1296
1297          --  Get its data
1298
1299          Current_Item :=
1300            Current_Item_Node
1301              (Current_Declarative_Item, From_Project_Node_Tree);
1302
1303          --  And set Current_Declarative_Item to the next declarative item
1304          --  ready for the next iteration.
1305
1306          Current_Declarative_Item :=
1307            Next_Declarative_Item
1308              (Current_Declarative_Item, From_Project_Node_Tree);
1309
1310          case Kind_Of (Current_Item, From_Project_Node_Tree) is
1311
1312             when N_Package_Declaration =>
1313                --  Do not process a package declaration that should be ignored
1314
1315                if Expression_Kind_Of
1316                     (Current_Item, From_Project_Node_Tree) /= Ignored
1317                then
1318                   --  Create the new package
1319
1320                   Package_Table.Increment_Last (In_Tree.Packages);
1321
1322                   declare
1323                      New_Pkg         : constant Package_Id :=
1324                                          Package_Table.Last (In_Tree.Packages);
1325                      The_New_Package : Package_Element;
1326
1327                      Project_Of_Renamed_Package :
1328                        constant Project_Node_Id :=
1329                          Project_Of_Renamed_Package_Of
1330                            (Current_Item, From_Project_Node_Tree);
1331
1332                   begin
1333                      --  Set the name of the new package
1334
1335                      The_New_Package.Name :=
1336                        Name_Of (Current_Item, From_Project_Node_Tree);
1337
1338                      --  Insert the new package in the appropriate list
1339
1340                      if Pkg /= No_Package then
1341                         The_New_Package.Next :=
1342                           In_Tree.Packages.Table (Pkg).Decl.Packages;
1343                         In_Tree.Packages.Table (Pkg).Decl.Packages :=
1344                           New_Pkg;
1345                      else
1346                         The_New_Package.Next :=
1347                           In_Tree.Projects.Table (Project).Decl.Packages;
1348                         In_Tree.Projects.Table (Project).Decl.Packages :=
1349                           New_Pkg;
1350                      end if;
1351
1352                      In_Tree.Packages.Table (New_Pkg) :=
1353                        The_New_Package;
1354
1355                      if Project_Of_Renamed_Package /= Empty_Node then
1356
1357                         --  Renamed package
1358
1359                         declare
1360                            Project_Name : constant Name_Id :=
1361                                             Name_Of
1362                                               (Project_Of_Renamed_Package,
1363                                                From_Project_Node_Tree);
1364
1365                            Renamed_Project :
1366                              constant Project_Id :=
1367                                Imported_Or_Extended_Project_From
1368                                (Project, In_Tree, Project_Name);
1369
1370                            Renamed_Package : constant Package_Id :=
1371                                                Package_From
1372                                                  (Renamed_Project, In_Tree,
1373                                                   Name_Of
1374                                                     (Current_Item,
1375                                                      From_Project_Node_Tree));
1376
1377                         begin
1378                            --  For a renamed package, copy the declarations of
1379                            --  the renamed package, but set all the locations
1380                            --  to the location of the package name in the
1381                            --  renaming declaration.
1382
1383                            Copy_Package_Declarations
1384                              (From     =>
1385                                 In_Tree.Packages.Table (Renamed_Package).Decl,
1386                               To      =>
1387                                 In_Tree.Packages.Table (New_Pkg).Decl,
1388                               New_Loc =>
1389                                 Location_Of
1390                                   (Current_Item, From_Project_Node_Tree),
1391                               In_Tree => In_Tree);
1392                         end;
1393
1394                      --  Standard package declaration, not renaming
1395
1396                      else
1397                         --  Set the default values of the attributes
1398
1399                         Add_Attributes
1400                           (Project, In_Tree,
1401                            In_Tree.Packages.Table (New_Pkg).Decl,
1402                            First_Attribute_Of
1403                              (Package_Id_Of
1404                                 (Current_Item, From_Project_Node_Tree)));
1405
1406                         --  And process declarative items of the new package
1407
1408                         Process_Declarative_Items
1409                           (Project                => Project,
1410                            In_Tree                => In_Tree,
1411                            From_Project_Node      => From_Project_Node,
1412                            From_Project_Node_Tree => From_Project_Node_Tree,
1413                            Pkg                    => New_Pkg,
1414                            Item                   =>
1415                              First_Declarative_Item_Of
1416                                (Current_Item, From_Project_Node_Tree));
1417                      end if;
1418                   end;
1419                end if;
1420
1421             when N_String_Type_Declaration =>
1422
1423                --  There is nothing to process
1424
1425                null;
1426
1427             when N_Attribute_Declaration      |
1428                  N_Typed_Variable_Declaration |
1429                  N_Variable_Declaration       =>
1430
1431                if Expression_Of (Current_Item, From_Project_Node_Tree) =
1432                     Empty_Node
1433                then
1434
1435                   --  It must be a full associative array attribute declaration
1436
1437                   declare
1438                      Current_Item_Name : constant Name_Id :=
1439                        Name_Of (Current_Item, From_Project_Node_Tree);
1440                      --  The name of the attribute
1441
1442                      New_Array  : Array_Id;
1443                      --  The new associative array created
1444
1445                      Orig_Array : Array_Id;
1446                      --  The associative array value
1447
1448                      Orig_Project_Name : Name_Id := No_Name;
1449                      --  The name of the project where the associative array
1450                      --  value is.
1451
1452                      Orig_Project : Project_Id := No_Project;
1453                      --  The id of the project where the associative array
1454                      --  value is.
1455
1456                      Orig_Package_Name : Name_Id := No_Name;
1457                      --  The name of the package, if any, where the associative
1458                      --  array value is.
1459
1460                      Orig_Package : Package_Id := No_Package;
1461                      --  The id of the package, if any, where the associative
1462                      --  array value is.
1463
1464                      New_Element : Array_Element_Id := No_Array_Element;
1465                      --  Id of a new array element created
1466
1467                      Prev_Element : Array_Element_Id := No_Array_Element;
1468                      --  Last new element id created
1469
1470                      Orig_Element : Array_Element_Id := No_Array_Element;
1471                      --  Current array element in the original associative
1472                      --  array.
1473
1474                      Next_Element : Array_Element_Id := No_Array_Element;
1475                      --  Id of the array element that follows the new element.
1476                      --  This is not always nil, because values for the
1477                      --  associative array attribute may already have been
1478                      --  declared, and the array elements declared are reused.
1479
1480                   begin
1481                      --  First, find if the associative array attribute already
1482                      --  has elements declared.
1483
1484                      if Pkg /= No_Package then
1485                         New_Array := In_Tree.Packages.Table
1486                                        (Pkg).Decl.Arrays;
1487
1488                      else
1489                         New_Array := In_Tree.Projects.Table
1490                                        (Project).Decl.Arrays;
1491                      end if;
1492
1493                      while New_Array /= No_Array
1494                        and then In_Tree.Arrays.Table (New_Array).Name /=
1495                                                            Current_Item_Name
1496                      loop
1497                         New_Array := In_Tree.Arrays.Table (New_Array).Next;
1498                      end loop;
1499
1500                      --  If the attribute has never been declared add new entry
1501                      --  in the arrays of the project/package and link it.
1502
1503                      if New_Array = No_Array then
1504                         Array_Table.Increment_Last (In_Tree.Arrays);
1505                         New_Array := Array_Table.Last (In_Tree.Arrays);
1506
1507                         if Pkg /= No_Package then
1508                            In_Tree.Arrays.Table (New_Array) :=
1509                              (Name  => Current_Item_Name,
1510                               Value => No_Array_Element,
1511                               Next  =>
1512                                 In_Tree.Packages.Table (Pkg).Decl.Arrays);
1513
1514                            In_Tree.Packages.Table (Pkg).Decl.Arrays :=
1515                              New_Array;
1516
1517                         else
1518                            In_Tree.Arrays.Table (New_Array) :=
1519                              (Name  => Current_Item_Name,
1520                               Value => No_Array_Element,
1521                               Next  =>
1522                                 In_Tree.Projects.Table (Project).Decl.Arrays);
1523
1524                            In_Tree.Projects.Table (Project).Decl.Arrays :=
1525                              New_Array;
1526                         end if;
1527                      end if;
1528
1529                      --  Find the project where the value is declared
1530
1531                      Orig_Project_Name :=
1532                        Name_Of
1533                          (Associative_Project_Of
1534                               (Current_Item, From_Project_Node_Tree),
1535                           From_Project_Node_Tree);
1536
1537                      for Index in Project_Table.First ..
1538                                   Project_Table.Last
1539                                     (In_Tree.Projects)
1540                      loop
1541                         if In_Tree.Projects.Table (Index).Name =
1542                                                            Orig_Project_Name
1543                         then
1544                            Orig_Project := Index;
1545                            exit;
1546                         end if;
1547                      end loop;
1548
1549                      pragma Assert (Orig_Project /= No_Project,
1550                                     "original project not found");
1551
1552                      if Associative_Package_Of
1553                           (Current_Item, From_Project_Node_Tree) = Empty_Node
1554                      then
1555                         Orig_Array :=
1556                           In_Tree.Projects.Table
1557                             (Orig_Project).Decl.Arrays;
1558
1559                      else
1560                         --  If in a package, find the package where the
1561                         --  value is declared.
1562
1563                         Orig_Package_Name :=
1564                           Name_Of
1565                             (Associative_Package_Of
1566                                  (Current_Item, From_Project_Node_Tree),
1567                              From_Project_Node_Tree);
1568
1569                         Orig_Package :=
1570                           In_Tree.Projects.Table
1571                             (Orig_Project).Decl.Packages;
1572                         pragma Assert (Orig_Package /= No_Package,
1573                                        "original package not found");
1574
1575                         while In_Tree.Packages.Table
1576                                 (Orig_Package).Name /= Orig_Package_Name
1577                         loop
1578                            Orig_Package := In_Tree.Packages.Table
1579                                              (Orig_Package).Next;
1580                            pragma Assert (Orig_Package /= No_Package,
1581                                           "original package not found");
1582                         end loop;
1583
1584                         Orig_Array :=
1585                           In_Tree.Packages.Table
1586                             (Orig_Package).Decl.Arrays;
1587                      end if;
1588
1589                      --  Now look for the array
1590
1591                      while Orig_Array /= No_Array and then
1592                      In_Tree.Arrays.Table (Orig_Array).Name /=
1593                                                          Current_Item_Name
1594                      loop
1595                         Orig_Array := In_Tree.Arrays.Table
1596                                         (Orig_Array).Next;
1597                      end loop;
1598
1599                      if Orig_Array = No_Array then
1600                         if Error_Report = null then
1601                            Error_Msg
1602                              ("associative array value cannot be found",
1603                               Location_Of
1604                                 (Current_Item, From_Project_Node_Tree));
1605
1606                         else
1607                            Error_Report
1608                              ("associative array value cannot be found",
1609                               Project, In_Tree);
1610                         end if;
1611
1612                      else
1613                         Orig_Element :=
1614                           In_Tree.Arrays.Table (Orig_Array).Value;
1615
1616                         --  Copy each array element
1617
1618                         while Orig_Element /= No_Array_Element loop
1619
1620                            --  Case of first element
1621
1622                            if Prev_Element = No_Array_Element then
1623
1624                               --  And there is no array element declared yet,
1625                               --  create a new first array element.
1626
1627                               if In_Tree.Arrays.Table (New_Array).Value =
1628                                                               No_Array_Element
1629                               then
1630                                  Array_Element_Table.Increment_Last
1631                                    (In_Tree.Array_Elements);
1632                                  New_Element := Array_Element_Table.Last
1633                                    (In_Tree.Array_Elements);
1634                                  In_Tree.Arrays.Table
1635                                    (New_Array).Value := New_Element;
1636                                  Next_Element := No_Array_Element;
1637
1638                               --  Otherwise, the new element is the first
1639
1640                               else
1641                                  New_Element := In_Tree.Arrays.
1642                                                   Table (New_Array).Value;
1643                                  Next_Element :=
1644                                    In_Tree.Array_Elements.Table
1645                                      (New_Element).Next;
1646                               end if;
1647
1648                            --  Otherwise, reuse an existing element, or create
1649                            --  one if necessary.
1650
1651                            else
1652                               Next_Element :=
1653                                 In_Tree.Array_Elements.Table
1654                                   (Prev_Element).Next;
1655
1656                               if Next_Element = No_Array_Element then
1657                                  Array_Element_Table.Increment_Last
1658                                    (In_Tree.Array_Elements);
1659                                  New_Element := Array_Element_Table.Last
1660                                    (In_Tree.Array_Elements);
1661
1662                               else
1663                                  New_Element := Next_Element;
1664                                  Next_Element :=
1665                                    In_Tree.Array_Elements.Table
1666                                      (New_Element).Next;
1667                               end if;
1668                            end if;
1669
1670                            --  Copy the value of the element
1671
1672                            In_Tree.Array_Elements.Table
1673                              (New_Element) :=
1674                                In_Tree.Array_Elements.Table
1675                                  (Orig_Element);
1676                            In_Tree.Array_Elements.Table
1677                              (New_Element).Value.Project := Project;
1678
1679                            --  Adjust the Next link
1680
1681                            In_Tree.Array_Elements.Table
1682                              (New_Element).Next := Next_Element;
1683
1684                            --  Adjust the previous id for the next element
1685
1686                            Prev_Element := New_Element;
1687
1688                            --  Go to the next element in the original array
1689
1690                            Orig_Element :=
1691                              In_Tree.Array_Elements.Table
1692                                (Orig_Element).Next;
1693                         end loop;
1694
1695                         --  Make sure that the array ends here, in case there
1696                         --  previously a greater number of elements.
1697
1698                         In_Tree.Array_Elements.Table
1699                           (New_Element).Next := No_Array_Element;
1700                      end if;
1701                   end;
1702
1703                --  Declarations other that full associative arrays
1704
1705                else
1706                   declare
1707                      New_Value : constant Variable_Value :=
1708                        Expression
1709                          (Project                => Project,
1710                           In_Tree                => In_Tree,
1711                           From_Project_Node      => From_Project_Node,
1712                           From_Project_Node_Tree => From_Project_Node_Tree,
1713                           Pkg                    => Pkg,
1714                           First_Term             =>
1715                             Tree.First_Term
1716                               (Expression_Of
1717                                    (Current_Item, From_Project_Node_Tree),
1718                                From_Project_Node_Tree),
1719                           Kind                   =>
1720                             Expression_Kind_Of
1721                               (Current_Item, From_Project_Node_Tree));
1722                      --  The expression value
1723
1724                      The_Variable : Variable_Id := No_Variable;
1725
1726                      Current_Item_Name : constant Name_Id :=
1727                        Name_Of (Current_Item, From_Project_Node_Tree);
1728
1729                   begin
1730                      --  Process a typed variable declaration
1731
1732                      if Kind_Of (Current_Item, From_Project_Node_Tree) =
1733                           N_Typed_Variable_Declaration
1734                      then
1735                         --  Report an error for an empty string
1736
1737                         if New_Value.Value = Empty_String then
1738                            Error_Msg_Name_1 :=
1739                              Name_Of (Current_Item, From_Project_Node_Tree);
1740
1741                            if Error_Report = null then
1742                               Error_Msg
1743                                 ("no value defined for %",
1744                                  Location_Of
1745                                    (Current_Item, From_Project_Node_Tree));
1746
1747                            else
1748                               Error_Report
1749                                 ("no value defined for " &
1750                                  Get_Name_String (Error_Msg_Name_1),
1751                                  Project, In_Tree);
1752                            end if;
1753
1754                         else
1755                            declare
1756                               Current_String : Project_Node_Id :=
1757                                                  First_Literal_String
1758                                                    (String_Type_Of
1759                                                       (Current_Item,
1760                                                        From_Project_Node_Tree),
1761                                                     From_Project_Node_Tree);
1762
1763                            begin
1764                               --  Loop through all the valid strings for the
1765                               --  string type and compare to the string value.
1766
1767                               while Current_String /= Empty_Node
1768                                 and then
1769                                   String_Value_Of
1770                                     (Current_String, From_Project_Node_Tree) /=
1771                                                                New_Value.Value
1772                               loop
1773                                  Current_String :=
1774                                    Next_Literal_String
1775                                      (Current_String, From_Project_Node_Tree);
1776                               end loop;
1777
1778                               --  Report an error if the string value is not
1779                               --  one for the string type.
1780
1781                               if Current_String = Empty_Node then
1782                                  Error_Msg_Name_1 := New_Value.Value;
1783                                  Error_Msg_Name_2 :=
1784                                    Name_Of
1785                                      (Current_Item, From_Project_Node_Tree);
1786
1787                                  if Error_Report = null then
1788                                     Error_Msg
1789                                       ("value { is illegal for typed string %",
1790                                        Location_Of
1791                                          (Current_Item,
1792                                           From_Project_Node_Tree));
1793
1794                                  else
1795                                     Error_Report
1796                                       ("value """ &
1797                                        Get_Name_String (Error_Msg_Name_1) &
1798                                        """ is illegal for typed string """ &
1799                                        Get_Name_String (Error_Msg_Name_2) &
1800                                        """",
1801                                        Project, In_Tree);
1802                                  end if;
1803                               end if;
1804                            end;
1805                         end if;
1806                      end if;
1807
1808                      if Kind_Of (Current_Item, From_Project_Node_Tree) /=
1809                           N_Attribute_Declaration
1810                        or else
1811                          Associative_Array_Index_Of
1812                            (Current_Item, From_Project_Node_Tree) = No_Name
1813                      then
1814                         --  Case of a variable declaration or of a not
1815                         --  associative array attribute.
1816
1817                         --  First, find the list where to find the variable
1818                         --  or attribute.
1819
1820                         if Kind_Of (Current_Item, From_Project_Node_Tree) =
1821                              N_Attribute_Declaration
1822                         then
1823                            if Pkg /= No_Package then
1824                               The_Variable :=
1825                                 In_Tree.Packages.Table
1826                                   (Pkg).Decl.Attributes;
1827                            else
1828                               The_Variable :=
1829                                 In_Tree.Projects.Table
1830                                   (Project).Decl.Attributes;
1831                            end if;
1832
1833                         else
1834                            if Pkg /= No_Package then
1835                               The_Variable :=
1836                                 In_Tree.Packages.Table
1837                                   (Pkg).Decl.Variables;
1838                            else
1839                               The_Variable :=
1840                                 In_Tree.Projects.Table
1841                                   (Project).Decl.Variables;
1842                            end if;
1843
1844                         end if;
1845
1846                         --  Loop through the list, to find if it has already
1847                         --  been declared.
1848
1849                         while The_Variable /= No_Variable
1850                           and then
1851                             In_Tree.Variable_Elements.Table
1852                               (The_Variable).Name /= Current_Item_Name
1853                         loop
1854                            The_Variable :=
1855                              In_Tree.Variable_Elements.Table
1856                                (The_Variable).Next;
1857                         end loop;
1858
1859                         --  If it has not been declared, create a new entry
1860                         --  in the list.
1861
1862                         if The_Variable = No_Variable then
1863
1864                            --  All single string attribute should already have
1865                            --  been declared with a default empty string value.
1866
1867                            pragma Assert
1868                              (Kind_Of (Current_Item, From_Project_Node_Tree) /=
1869                                 N_Attribute_Declaration,
1870                               "illegal attribute declaration");
1871
1872                            Variable_Element_Table.Increment_Last
1873                              (In_Tree.Variable_Elements);
1874                            The_Variable := Variable_Element_Table.Last
1875                              (In_Tree.Variable_Elements);
1876
1877                            --  Put the new variable in the appropriate list
1878
1879                            if Pkg /= No_Package then
1880                               In_Tree.Variable_Elements.Table (The_Variable) :=
1881                                 (Next    =>
1882                                    In_Tree.Packages.Table
1883                                      (Pkg).Decl.Variables,
1884                                  Name    => Current_Item_Name,
1885                                  Value   => New_Value);
1886                               In_Tree.Packages.Table
1887                                 (Pkg).Decl.Variables := The_Variable;
1888
1889                            else
1890                               In_Tree.Variable_Elements.Table (The_Variable) :=
1891                                 (Next    =>
1892                                    In_Tree.Projects.Table
1893                                      (Project).Decl.Variables,
1894                                  Name    => Current_Item_Name,
1895                                  Value   => New_Value);
1896                               In_Tree.Projects.Table
1897                                 (Project).Decl.Variables :=
1898                                   The_Variable;
1899                            end if;
1900
1901                         --  If the variable/attribute has already been
1902                         --  declared, just change the value.
1903
1904                         else
1905                            In_Tree.Variable_Elements.Table
1906                              (The_Variable).Value :=
1907                                 New_Value;
1908
1909                         end if;
1910
1911                      else
1912                         --  Associative array attribute
1913
1914                         --  Get the string index
1915
1916                         Get_Name_String
1917                           (Associative_Array_Index_Of
1918                              (Current_Item, From_Project_Node_Tree));
1919
1920                         --  Put in lower case, if necessary
1921
1922                         if Case_Insensitive
1923                              (Current_Item, From_Project_Node_Tree)
1924                         then
1925                            GNAT.Case_Util.To_Lower
1926                                             (Name_Buffer (1 .. Name_Len));
1927                         end if;
1928
1929                         declare
1930                            The_Array : Array_Id;
1931
1932                            The_Array_Element : Array_Element_Id :=
1933                                                  No_Array_Element;
1934
1935                            Index_Name : constant Name_Id := Name_Find;
1936                            --  The name id of the index
1937
1938                         begin
1939                            --  Look for the array in the appropriate list
1940
1941                            if Pkg /= No_Package then
1942                               The_Array := In_Tree.Packages.Table
1943                                              (Pkg).Decl.Arrays;
1944
1945                            else
1946                               The_Array := In_Tree.Projects.Table
1947                                              (Project).Decl.Arrays;
1948                            end if;
1949
1950                            while
1951                              The_Array /= No_Array
1952                              and then In_Tree.Arrays.Table
1953                                         (The_Array).Name /= Current_Item_Name
1954                            loop
1955                               The_Array := In_Tree.Arrays.Table
1956                                              (The_Array).Next;
1957                            end loop;
1958
1959                            --  If the array cannot be found, create a new
1960                            --  entry in the list. As The_Array_Element is
1961                            --  initialized to No_Array_Element, a new element
1962                            --  will be created automatically later.
1963
1964                            if The_Array = No_Array then
1965                               Array_Table.Increment_Last
1966                                 (In_Tree.Arrays);
1967                               The_Array := Array_Table.Last
1968                                 (In_Tree.Arrays);
1969
1970                               if Pkg /= No_Package then
1971                                  In_Tree.Arrays.Table
1972                                    (The_Array) :=
1973                                    (Name  => Current_Item_Name,
1974                                     Value => No_Array_Element,
1975                                     Next  =>
1976                                       In_Tree.Packages.Table
1977                                         (Pkg).Decl.Arrays);
1978
1979                                  In_Tree.Packages.Table
1980                                    (Pkg).Decl.Arrays :=
1981                                      The_Array;
1982
1983                               else
1984                                  In_Tree.Arrays.Table
1985                                    (The_Array) :=
1986                                    (Name  => Current_Item_Name,
1987                                     Value => No_Array_Element,
1988                                     Next  =>
1989                                       In_Tree.Projects.Table
1990                                         (Project).Decl.Arrays);
1991
1992                                  In_Tree.Projects.Table
1993                                    (Project).Decl.Arrays :=
1994                                      The_Array;
1995                               end if;
1996
1997                            --  Otherwise, initialize The_Array_Element as the
1998                            --  head of the element list.
1999
2000                            else
2001                               The_Array_Element :=
2002                                 In_Tree.Arrays.Table
2003                                   (The_Array).Value;
2004                            end if;
2005
2006                            --  Look in the list, if any, to find an element
2007                            --  with the same index.
2008
2009                            while The_Array_Element /= No_Array_Element
2010                              and then
2011                                In_Tree.Array_Elements.Table
2012                                  (The_Array_Element).Index /= Index_Name
2013                            loop
2014                               The_Array_Element :=
2015                                 In_Tree.Array_Elements.Table
2016                                   (The_Array_Element).Next;
2017                            end loop;
2018
2019                            --  If no such element were found, create a new
2020                            --  one and insert it in the element list, with
2021                            --  the propoer value.
2022
2023                            if The_Array_Element = No_Array_Element then
2024                               Array_Element_Table.Increment_Last
2025                                 (In_Tree.Array_Elements);
2026                               The_Array_Element := Array_Element_Table.Last
2027                                 (In_Tree.Array_Elements);
2028
2029                               In_Tree.Array_Elements.Table
2030                                 (The_Array_Element) :=
2031                                 (Index  => Index_Name,
2032                                  Src_Index =>
2033                                    Source_Index_Of
2034                                      (Current_Item, From_Project_Node_Tree),
2035                                  Index_Case_Sensitive =>
2036                                  not Case_Insensitive
2037                                    (Current_Item, From_Project_Node_Tree),
2038                                  Value  => New_Value,
2039                                  Next => In_Tree.Arrays.Table
2040                                            (The_Array).Value);
2041                               In_Tree.Arrays.Table
2042                                 (The_Array).Value := The_Array_Element;
2043
2044                            --  An element with the same index already exists,
2045                            --  just replace its value with the new one.
2046
2047                            else
2048                               In_Tree.Array_Elements.Table
2049                                 (The_Array_Element).Value := New_Value;
2050                            end if;
2051                         end;
2052                      end if;
2053                   end;
2054                end if;
2055
2056             when N_Case_Construction =>
2057                declare
2058                   The_Project   : Project_Id      := Project;
2059                   --  The id of the project of the case variable
2060
2061                   The_Package   : Package_Id      := Pkg;
2062                   --  The id of the package, if any, of the case variable
2063
2064                   The_Variable  : Variable_Value  := Nil_Variable_Value;
2065                   --  The case variable
2066
2067                   Case_Value    : Name_Id         := No_Name;
2068                   --  The case variable value
2069
2070                   Case_Item     : Project_Node_Id := Empty_Node;
2071                   Choice_String : Project_Node_Id := Empty_Node;
2072                   Decl_Item     : Project_Node_Id := Empty_Node;
2073
2074                begin
2075                   declare
2076                      Variable_Node : constant Project_Node_Id :=
2077                                        Case_Variable_Reference_Of
2078                                          (Current_Item,
2079                                           From_Project_Node_Tree);
2080
2081                      Var_Id : Variable_Id := No_Variable;
2082                      Name   : Name_Id     := No_Name;
2083
2084                   begin
2085                      --  If a project were specified for the case variable,
2086                      --  get its id.
2087
2088                      if Project_Node_Of
2089                        (Variable_Node, From_Project_Node_Tree) /= Empty_Node
2090                      then
2091                         Name :=
2092                           Name_Of
2093                             (Project_Node_Of
2094                                (Variable_Node, From_Project_Node_Tree),
2095                              From_Project_Node_Tree);
2096                         The_Project :=
2097                           Imported_Or_Extended_Project_From
2098                             (Project, In_Tree, Name);
2099                      end if;
2100
2101                      --  If a package were specified for the case variable,
2102                      --  get its id.
2103
2104                      if Package_Node_Of
2105                        (Variable_Node, From_Project_Node_Tree) /= Empty_Node
2106                      then
2107                         Name :=
2108                           Name_Of
2109                             (Package_Node_Of
2110                                (Variable_Node, From_Project_Node_Tree),
2111                              From_Project_Node_Tree);
2112                         The_Package :=
2113                           Package_From (The_Project, In_Tree, Name);
2114                      end if;
2115
2116                      Name := Name_Of (Variable_Node, From_Project_Node_Tree);
2117
2118                      --  First, look for the case variable into the package,
2119                      --  if any.
2120
2121                      if The_Package /= No_Package then
2122                         Var_Id := In_Tree.Packages.Table
2123                                     (The_Package).Decl.Variables;
2124                         Name :=
2125                           Name_Of (Variable_Node, From_Project_Node_Tree);
2126                         while Var_Id /= No_Variable
2127                           and then
2128                             In_Tree.Variable_Elements.Table
2129                               (Var_Id).Name /= Name
2130                         loop
2131                            Var_Id := In_Tree.Variable_Elements.
2132                                        Table (Var_Id).Next;
2133                         end loop;
2134                      end if;
2135
2136                      --  If not found in the package, or if there is no
2137                      --  package, look at the project level.
2138
2139                      if Var_Id = No_Variable
2140                         and then
2141                         Package_Node_Of
2142                           (Variable_Node, From_Project_Node_Tree) = Empty_Node
2143                      then
2144                         Var_Id := In_Tree.Projects.Table
2145                                     (The_Project).Decl.Variables;
2146                         while Var_Id /= No_Variable
2147                           and then
2148                             In_Tree.Variable_Elements.Table
2149                               (Var_Id).Name /= Name
2150                         loop
2151                            Var_Id := In_Tree.Variable_Elements.
2152                                        Table (Var_Id).Next;
2153                         end loop;
2154                      end if;
2155
2156                      if Var_Id = No_Variable then
2157
2158                         --  Should never happen, because this has already been
2159                         --  checked during parsing.
2160
2161                         Write_Line ("variable """ &
2162                                     Get_Name_String (Name) &
2163                                     """ not found");
2164                         raise Program_Error;
2165                      end if;
2166
2167                      --  Get the case variable
2168
2169                      The_Variable := In_Tree.Variable_Elements.
2170                                        Table (Var_Id).Value;
2171
2172                      if The_Variable.Kind /= Single then
2173
2174                         --  Should never happen, because this has already been
2175                         --  checked during parsing.
2176
2177                         Write_Line ("variable""" &
2178                                     Get_Name_String (Name) &
2179                                     """ is not a single string variable");
2180                         raise Program_Error;
2181                      end if;
2182
2183                      --  Get the case variable value
2184                      Case_Value := The_Variable.Value;
2185                   end;
2186
2187                   --  Now look into all the case items of the case construction
2188
2189                   Case_Item :=
2190                     First_Case_Item_Of (Current_Item, From_Project_Node_Tree);
2191                   Case_Item_Loop :
2192                      while Case_Item /= Empty_Node loop
2193                         Choice_String :=
2194                           First_Choice_Of (Case_Item, From_Project_Node_Tree);
2195
2196                         --  When Choice_String is nil, it means that it is
2197                         --  the "when others =>" alternative.
2198
2199                         if Choice_String = Empty_Node then
2200                            Decl_Item :=
2201                              First_Declarative_Item_Of
2202                                (Case_Item, From_Project_Node_Tree);
2203                            exit Case_Item_Loop;
2204                         end if;
2205
2206                         --  Look into all the alternative of this case item
2207
2208                         Choice_Loop :
2209                            while Choice_String /= Empty_Node loop
2210                               if Case_Value =
2211                                 String_Value_Of
2212                                   (Choice_String, From_Project_Node_Tree)
2213                               then
2214                                  Decl_Item :=
2215                                    First_Declarative_Item_Of
2216                                      (Case_Item, From_Project_Node_Tree);
2217                                  exit Case_Item_Loop;
2218                               end if;
2219
2220                               Choice_String :=
2221                                 Next_Literal_String
2222                                   (Choice_String, From_Project_Node_Tree);
2223                            end loop Choice_Loop;
2224
2225                         Case_Item :=
2226                           Next_Case_Item (Case_Item, From_Project_Node_Tree);
2227                      end loop Case_Item_Loop;
2228
2229                   --  If there is an alternative, then we process it
2230
2231                   if Decl_Item /= Empty_Node then
2232                      Process_Declarative_Items
2233                        (Project                => Project,
2234                         In_Tree                => In_Tree,
2235                         From_Project_Node      => From_Project_Node,
2236                         From_Project_Node_Tree => From_Project_Node_Tree,
2237                         Pkg                    => Pkg,
2238                         Item                   => Decl_Item);
2239                   end if;
2240                end;
2241
2242             when others =>
2243
2244                --  Should never happen
2245
2246                Write_Line ("Illegal declarative item: " &
2247                            Project_Node_Kind'Image
2248                              (Kind_Of
2249                                 (Current_Item, From_Project_Node_Tree)));
2250                raise Program_Error;
2251          end case;
2252       end loop;
2253    end Process_Declarative_Items;
2254
2255    ---------------------
2256    -- Recursive_Check --
2257    ---------------------
2258
2259    procedure Recursive_Check
2260      (Project         : Project_Id;
2261       In_Tree         : Project_Tree_Ref;
2262       Follow_Links    : Boolean;
2263       When_No_Sources : Error_Warning)
2264    is
2265       Data                  : Project_Data;
2266       Imported_Project_List : Project_List := Empty_Project_List;
2267
2268    begin
2269       --  Do nothing if Project is No_Project, or Project has already
2270       --  been marked as checked.
2271
2272       if Project /= No_Project
2273         and then not In_Tree.Projects.Table (Project).Checked
2274       then
2275          --  Mark project as checked, to avoid infinite recursion in
2276          --  ill-formed trees, where a project imports itself.
2277
2278          In_Tree.Projects.Table (Project).Checked := True;
2279
2280          Data := In_Tree.Projects.Table (Project);
2281
2282          --  Call itself for a possible extended project.
2283          --  (if there is no extended project, then nothing happens).
2284
2285          Recursive_Check
2286            (Data.Extends, In_Tree, Follow_Links, When_No_Sources);
2287
2288          --  Call itself for all imported projects
2289
2290          Imported_Project_List := Data.Imported_Projects;
2291          while Imported_Project_List /= Empty_Project_List loop
2292             Recursive_Check
2293               (In_Tree.Project_Lists.Table
2294                  (Imported_Project_List).Project,
2295                In_Tree, Follow_Links, When_No_Sources);
2296             Imported_Project_List :=
2297               In_Tree.Project_Lists.Table
2298                 (Imported_Project_List).Next;
2299          end loop;
2300
2301          if Verbose_Mode then
2302             Write_Str ("Checking project file """);
2303             Write_Str (Get_Name_String (Data.Name));
2304             Write_Line ("""");
2305          end if;
2306
2307          Prj.Nmsc.Check
2308            (Project, In_Tree, Error_Report, Follow_Links, When_No_Sources);
2309       end if;
2310    end Recursive_Check;
2311
2312    -----------------------
2313    -- Recursive_Process --
2314    -----------------------
2315
2316    procedure Recursive_Process
2317      (In_Tree                : Project_Tree_Ref;
2318       Project                : out Project_Id;
2319       From_Project_Node      : Project_Node_Id;
2320       From_Project_Node_Tree : Project_Node_Tree_Ref;
2321       Extended_By            : Project_Id)
2322    is
2323       With_Clause : Project_Node_Id;
2324
2325    begin
2326       if From_Project_Node = Empty_Node then
2327          Project := No_Project;
2328
2329       else
2330          declare
2331             Processed_Data   : Project_Data     := Empty_Project (In_Tree);
2332             Imported         : Project_List     := Empty_Project_List;
2333             Declaration_Node : Project_Node_Id  := Empty_Node;
2334             Tref             : Source_Buffer_Ptr;
2335             Name             : constant Name_Id :=
2336                                  Name_Of
2337                                    (From_Project_Node, From_Project_Node_Tree);
2338             Location         : Source_Ptr :=
2339                                  Location_Of
2340                                    (From_Project_Node, From_Project_Node_Tree);
2341
2342          begin
2343             Project := Processed_Projects.Get (Name);
2344
2345             if Project /= No_Project then
2346
2347                --  Make sure that, when a project is extended, the project id
2348                --  of the project extending it is recorded in its data, even
2349                --  when it has already been processed as an imported project.
2350                --  This is for virtually extended projects.
2351
2352                if Extended_By /= No_Project then
2353                   In_Tree.Projects.Table (Project).Extended_By := Extended_By;
2354                end if;
2355
2356                return;
2357             end if;
2358
2359             Project_Table.Increment_Last (In_Tree.Projects);
2360             Project := Project_Table.Last (In_Tree.Projects);
2361             Processed_Projects.Set (Name, Project);
2362
2363             Processed_Data.Name := Name;
2364
2365             Get_Name_String (Name);
2366
2367             --  If name starts with the virtual prefix, flag the project as
2368             --  being a virtual extending project.
2369
2370             if Name_Len > Virtual_Prefix'Length
2371               and then Name_Buffer (1 .. Virtual_Prefix'Length) =
2372                          Virtual_Prefix
2373             then
2374                Processed_Data.Virtual := True;
2375                Processed_Data.Display_Name := Name;
2376
2377             --  If there is no file, for example when the project node tree is
2378             --  built in memory by GPS, the Display_Name cannot be found in
2379             --  the source, so its value is the same as Name.
2380
2381             elsif Location = No_Location then
2382                Processed_Data.Display_Name := Name;
2383
2384             --  Get the spelling of the project name from the project file
2385
2386             else
2387                Tref := Source_Text (Get_Source_File_Index (Location));
2388
2389                for J in 1 .. Name_Len loop
2390                   Name_Buffer (J) := Tref (Location);
2391                   Location := Location + 1;
2392                end loop;
2393
2394                Processed_Data.Display_Name := Name_Find;
2395             end if;
2396
2397             Processed_Data.Display_Path_Name :=
2398               Path_Name_Of (From_Project_Node, From_Project_Node_Tree);
2399             Get_Name_String (Processed_Data.Display_Path_Name);
2400             Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2401             Processed_Data.Path_Name := Name_Find;
2402
2403             Processed_Data.Location :=
2404               Location_Of (From_Project_Node, From_Project_Node_Tree);
2405
2406             Processed_Data.Display_Directory :=
2407               Directory_Of (From_Project_Node, From_Project_Node_Tree);
2408             Get_Name_String (Processed_Data.Display_Directory);
2409             Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2410             Processed_Data.Directory := Name_Find;
2411
2412             Processed_Data.Extended_By := Extended_By;
2413
2414             Add_Attributes
2415               (Project, In_Tree, Processed_Data.Decl, Attribute_First);
2416             With_Clause :=
2417               First_With_Clause_Of (From_Project_Node, From_Project_Node_Tree);
2418
2419             while With_Clause /= Empty_Node loop
2420                declare
2421                   New_Project : Project_Id;
2422                   New_Data    : Project_Data;
2423
2424                begin
2425                   Recursive_Process
2426                     (In_Tree                => In_Tree,
2427                      Project                => New_Project,
2428                      From_Project_Node      =>
2429                        Project_Node_Of (With_Clause, From_Project_Node_Tree),
2430                      From_Project_Node_Tree => From_Project_Node_Tree,
2431                      Extended_By            => No_Project);
2432                   New_Data :=
2433                     In_Tree.Projects.Table (New_Project);
2434
2435                   --  If we were the first project to import it,
2436                   --  set First_Referred_By to us.
2437
2438                   if New_Data.First_Referred_By = No_Project then
2439                      New_Data.First_Referred_By := Project;
2440                      In_Tree.Projects.Table (New_Project) :=
2441                        New_Data;
2442                   end if;
2443
2444                   --  Add this project to our list of imported projects
2445
2446                   Project_List_Table.Increment_Last
2447                     (In_Tree.Project_Lists);
2448                   In_Tree.Project_Lists.Table
2449                     (Project_List_Table.Last
2450                        (In_Tree.Project_Lists)) :=
2451                     (Project => New_Project, Next => Empty_Project_List);
2452
2453                   --  Imported is the id of the last imported project.
2454                   --  If it is nil, then this imported project is our first.
2455
2456                   if Imported = Empty_Project_List then
2457                      Processed_Data.Imported_Projects :=
2458                        Project_List_Table.Last
2459                          (In_Tree.Project_Lists);
2460
2461                   else
2462                      In_Tree.Project_Lists.Table
2463                        (Imported).Next := Project_List_Table.Last
2464                           (In_Tree.Project_Lists);
2465                   end if;
2466
2467                   Imported := Project_List_Table.Last
2468                                 (In_Tree.Project_Lists);
2469
2470                   With_Clause :=
2471                     Next_With_Clause_Of (With_Clause, From_Project_Node_Tree);
2472                end;
2473             end loop;
2474
2475             Declaration_Node :=
2476               Project_Declaration_Of
2477                 (From_Project_Node, From_Project_Node_Tree);
2478
2479             Recursive_Process
2480               (In_Tree                => In_Tree,
2481                Project                => Processed_Data.Extends,
2482                From_Project_Node      =>
2483                  Extended_Project_Of
2484                    (Declaration_Node, From_Project_Node_Tree),
2485                From_Project_Node_Tree => From_Project_Node_Tree,
2486                Extended_By            => Project);
2487
2488             In_Tree.Projects.Table (Project) := Processed_Data;
2489
2490             Process_Declarative_Items
2491               (Project                => Project,
2492                In_Tree                => In_Tree,
2493                From_Project_Node      => From_Project_Node,
2494                From_Project_Node_Tree => From_Project_Node_Tree,
2495                Pkg                    => No_Package,
2496                Item                   =>
2497                  First_Declarative_Item_Of
2498                    (Declaration_Node, From_Project_Node_Tree));
2499
2500             --  If it is an extending project, inherit all packages
2501             --  from the extended project that are not explicitely defined
2502             --  or renamed. Also inherit the languages, if attribute Languages
2503             --  is not explicitely defined.
2504
2505             if Processed_Data.Extends /= No_Project then
2506                Processed_Data := In_Tree.Projects.Table (Project);
2507
2508                declare
2509                   Extended_Pkg : Package_Id :=
2510                                    In_Tree.Projects.Table
2511                                      (Processed_Data.Extends).Decl.Packages;
2512                   Current_Pkg : Package_Id;
2513                   Element     : Package_Element;
2514                   First       : constant Package_Id :=
2515                                   Processed_Data.Decl.Packages;
2516                   Attribute1  : Variable_Id;
2517                   Attribute2  : Variable_Id;
2518                   Attr_Value1 : Variable;
2519                   Attr_Value2  : Variable;
2520
2521                begin
2522                   while Extended_Pkg /= No_Package loop
2523                      Element :=
2524                        In_Tree.Packages.Table (Extended_Pkg);
2525
2526                      Current_Pkg := First;
2527
2528                      loop
2529                         exit when Current_Pkg = No_Package
2530                           or else In_Tree.Packages.Table
2531                                     (Current_Pkg).Name = Element.Name;
2532                         Current_Pkg := In_Tree.Packages.Table
2533                                          (Current_Pkg).Next;
2534                      end loop;
2535
2536                      if Current_Pkg = No_Package then
2537                         Package_Table.Increment_Last
2538                           (In_Tree.Packages);
2539                         Current_Pkg := Package_Table.Last
2540                           (In_Tree.Packages);
2541                         In_Tree.Packages.Table (Current_Pkg) :=
2542                           (Name   => Element.Name,
2543                            Decl   => Element.Decl,
2544                            Parent => No_Package,
2545                            Next   => Processed_Data.Decl.Packages);
2546                         Processed_Data.Decl.Packages := Current_Pkg;
2547                      end if;
2548
2549                      Extended_Pkg := Element.Next;
2550                   end loop;
2551
2552                   --  Check if attribute Languages is declared in the
2553                   --  extending project.
2554
2555                   Attribute1 := Processed_Data.Decl.Attributes;
2556                   while Attribute1 /= No_Variable loop
2557                      Attr_Value1 := In_Tree.Variable_Elements.
2558                                       Table (Attribute1);
2559                      exit when Attr_Value1.Name = Snames.Name_Languages;
2560                      Attribute1 := Attr_Value1.Next;
2561                   end loop;
2562
2563                   if Attribute1 = No_Variable or else
2564                      Attr_Value1.Value.Default
2565                   then
2566                      --  Attribute Languages is not declared in the extending
2567                      --  project. Check if it is declared in the project being
2568                      --  extended.
2569
2570                      Attribute2 :=
2571                        In_Tree.Projects.Table
2572                          (Processed_Data.Extends).Decl.Attributes;
2573
2574                      while Attribute2 /= No_Variable loop
2575                         Attr_Value2 := In_Tree.Variable_Elements.
2576                                          Table (Attribute2);
2577                         exit when Attr_Value2.Name = Snames.Name_Languages;
2578                         Attribute2 := Attr_Value2.Next;
2579                      end loop;
2580
2581                      if Attribute2 /= No_Variable and then
2582                         not Attr_Value2.Value.Default
2583                      then
2584                         --  As attribute Languages is declared in the project
2585                         --  being extended, copy its value for the extending
2586                         --  project.
2587
2588                         if Attribute1 = No_Variable then
2589                            Variable_Element_Table.Increment_Last
2590                              (In_Tree.Variable_Elements);
2591                            Attribute1 := Variable_Element_Table.Last
2592                              (In_Tree.Variable_Elements);
2593                            Attr_Value1.Next := Processed_Data.Decl.Attributes;
2594                            Processed_Data.Decl.Attributes := Attribute1;
2595                         end if;
2596
2597                         Attr_Value1.Name := Snames.Name_Languages;
2598                         Attr_Value1.Value := Attr_Value2.Value;
2599                         In_Tree.Variable_Elements.Table
2600                           (Attribute1) := Attr_Value1;
2601                      end if;
2602                   end if;
2603                end;
2604
2605                In_Tree.Projects.Table (Project) := Processed_Data;
2606             end if;
2607          end;
2608       end if;
2609    end Recursive_Process;
2610
2611 end Prj.Proc;