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