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    procedure Check
  67      (Project           : in out Project_Id;
  68       Process_Languages : Languages_Processed;
  69       Follow_Links      : Boolean);
  70    --  Set all projects to not checked, then call Recursive_Check for the
  71    --  main project Project. Project is set to No_Project if errors occurred.
  72    --  See Prj.Nmsc.Ada_Check for information on Follow_Links.
  73
  74    function Expression
  75      (Project           : Project_Id;
  76       From_Project_Node : Project_Node_Id;
  77       Pkg               : Package_Id;
  78       First_Term        : Project_Node_Id;
  79       Kind              : Variable_Kind) return Variable_Value;
  80    --  From N_Expression project node From_Project_Node, compute the value
  81    --  of an expression and return it as a Variable_Value.
  82
  83    function Imported_Or_Extended_Project_From
  84      (Project   : Project_Id;
  85       With_Name : Name_Id) return Project_Id;
  86    --  Find an imported or extended project of Project whose name is With_Name
  87
  88    function Package_From
  89      (Project   : Project_Id;
  90       With_Name : Name_Id) return Package_Id;
  91    --  Find the package of Project whose name is With_Name
  92
  93    procedure Process_Declarative_Items
  94      (Project           : Project_Id;
  95       From_Project_Node : Project_Node_Id;
  96       Pkg               : Package_Id;
  97       Item              : Project_Node_Id);
  98    --  Process declarative items starting with From_Project_Node, and put them
  99    --  in declarations Decl. This is a recursive procedure; it calls itself for
 100    --  a package declaration or a case construction.
 101
 102    procedure Recursive_Process
 103      (Project           : out Project_Id;
 104       From_Project_Node : Project_Node_Id;
 105       Extended_By       : Project_Id);
 106    --  Process project with node From_Project_Node in the tree.
 107    --  Do nothing if From_Project_Node is Empty_Node.
 108    --  If project has already been processed, simply return its project id.
 109    --  Otherwise create a new project id, mark it as processed, call itself
 110    --  recursively for all imported projects and a extended project, if any.
 111    --  Then process the declarative items of the project.
 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 ((Process_Languages = Ada_Language
 907                        and then
 908                        Projects.Table (Extending2).Ada_Sources_Present)
 909                       or else
 910                        (Process_Languages = Other_Languages
 911                         and then
 912                         Projects.Table (Extending2).Other_Sources_Present))
 913                     and then
 914                       Projects.Table (Extending2).Object_Directory = Obj_Dir
 915                   then
 916                      if Projects.Table (Extending2).Virtual then
 917                         Error_Msg_Name_1 := Projects.Table (Proj).Name;
 918
 919                         if Error_Report = null then
 920                            Error_Msg
 921                              ("project % cannot be extended by a virtual " &
 922                               "project with the same object directory",
 923                               Projects.Table (Proj).Location);
 924
 925                         else
 926                            Error_Report
 927                              ("project """ &
 928                               Get_Name_String (Error_Msg_Name_1) &
 929                               """ cannot be extended by a virtual " &
 930                               "project with the same object directory",
 931                               Project);
 932                         end if;
 933
 934                      else
 935                         Error_Msg_Name_1 :=
 936                           Projects.Table (Extending2).Name;
 937                         Error_Msg_Name_2 := Projects.Table (Proj).Name;
 938
 939                         if Error_Report = null then
 940                            Error_Msg
 941                              ("project % cannot extend project %",
 942                               Projects.Table (Extending2).Location);
 943                            Error_Msg
 944                              ("\they share the same object directory",
 945                               Projects.Table (Extending2).Location);
 946
 947                         else
 948                            Error_Report
 949                              ("project """ &
 950                               Get_Name_String (Error_Msg_Name_1) &
 951                               """ cannot extend project """ &
 952                               Get_Name_String (Error_Msg_Name_2) & """",
 953                               Project);
 954                            Error_Report
 955                              ("they share the same object directory",
 956                               Project);
 957                         end if;
 958                      end if;
 959                   end if;
 960
 961                   --  Continue with the next extending project, if any
 962
 963                   Extending2 := Projects.Table (Extending2).Extended_By;
 964                end loop;
 965             end if;
 966          end loop;
 967       end if;
 968
 969       Success := Total_Errors_Detected <= 0;
 970    end Process;
 971
 972    -------------------------------
 973    -- Process_Declarative_Items --
 974    -------------------------------
 975
 976    procedure Process_Declarative_Items
 977      (Project           : Project_Id;
 978       From_Project_Node : Project_Node_Id;
 979       Pkg               : Package_Id;
 980       Item              : Project_Node_Id)
 981    is
 982       Current_Declarative_Item : Project_Node_Id := Item;
 983       Current_Item             : Project_Node_Id := Empty_Node;
 984
 985    begin
 986       --  For each declarative item
 987
 988       while Current_Declarative_Item /= Empty_Node loop
 989
 990          --  Get its data
 991
 992          Current_Item := Current_Item_Node (Current_Declarative_Item);
 993
 994          --  And set Current_Declarative_Item to the next declarative item
 995          --  ready for the next iteration.
 996
 997          Current_Declarative_Item := Next_Declarative_Item
 998                                             (Current_Declarative_Item);
 999
1000          case Kind_Of (Current_Item) is
1001
1002             when N_Package_Declaration =>
1003                --  Do not process a package declaration that should be ignored
1004
1005                if Expression_Kind_Of (Current_Item) /= Ignored then
1006                   --  Create the new package
1007
1008                   Packages.Increment_Last;
1009
1010                   declare
1011                      New_Pkg         : constant Package_Id := Packages.Last;
1012                      The_New_Package : Package_Element;
1013
1014                      Project_Of_Renamed_Package : constant Project_Node_Id :=
1015                        Project_Of_Renamed_Package_Of
1016                        (Current_Item);
1017
1018                   begin
1019                      --  Set the name of the new package
1020
1021                      The_New_Package.Name := Name_Of (Current_Item);
1022
1023                      --  Insert the new package in the appropriate list
1024
1025                      if Pkg /= No_Package then
1026                         The_New_Package.Next :=
1027                           Packages.Table (Pkg).Decl.Packages;
1028                         Packages.Table (Pkg).Decl.Packages := New_Pkg;
1029                      else
1030                         The_New_Package.Next :=
1031                           Projects.Table (Project).Decl.Packages;
1032                         Projects.Table (Project).Decl.Packages := New_Pkg;
1033                      end if;
1034
1035                      Packages.Table (New_Pkg) := The_New_Package;
1036
1037                      if Project_Of_Renamed_Package /= Empty_Node then
1038
1039                         --  Renamed package
1040
1041                         declare
1042                            Project_Name : constant Name_Id :=
1043                              Name_Of
1044                              (Project_Of_Renamed_Package);
1045
1046                            Renamed_Project : constant Project_Id :=
1047                              Imported_Or_Extended_Project_From
1048                              (Project, Project_Name);
1049
1050                            Renamed_Package : constant Package_Id :=
1051                              Package_From
1052                              (Renamed_Project,
1053                               Name_Of (Current_Item));
1054
1055                         begin
1056                            --  For a renamed package, set declarations to
1057                            --  the declarations of the renamed package.
1058
1059                            Packages.Table (New_Pkg).Decl :=
1060                              Packages.Table (Renamed_Package).Decl;
1061                         end;
1062
1063                      --  Standard package declaration, not renaming
1064
1065                      else
1066                         --  Set the default values of the attributes
1067
1068                         Add_Attributes
1069                           (Project,
1070                            Packages.Table (New_Pkg).Decl,
1071                            Package_Attributes.Table
1072                              (Package_Id_Of (Current_Item)).First_Attribute);
1073
1074                         --  And process declarative items of the new package
1075
1076                         Process_Declarative_Items
1077                           (Project           => Project,
1078                            From_Project_Node => From_Project_Node,
1079                            Pkg               => New_Pkg,
1080                            Item              => First_Declarative_Item_Of
1081                              (Current_Item));
1082                      end if;
1083                   end;
1084                end if;
1085
1086             when N_String_Type_Declaration =>
1087
1088                --  There is nothing to process
1089
1090                null;
1091
1092             when N_Attribute_Declaration      |
1093                  N_Typed_Variable_Declaration |
1094                  N_Variable_Declaration       =>
1095
1096                if Expression_Of (Current_Item) = Empty_Node then
1097
1098                   --  It must be a full associative array attribute declaration
1099
1100                   declare
1101                      Current_Item_Name : constant Name_Id :=
1102                                            Name_Of (Current_Item);
1103                      --  The name of the attribute
1104
1105                      New_Array  : Array_Id;
1106                      --  The new associative array created
1107
1108                      Orig_Array : Array_Id;
1109                      --  The associative array value
1110
1111                      Orig_Project_Name : Name_Id := No_Name;
1112                      --  The name of the project where the associative array
1113                      --  value is.
1114
1115                      Orig_Project : Project_Id := No_Project;
1116                      --  The id of the project where the associative array
1117                      --  value is.
1118
1119                      Orig_Package_Name : Name_Id := No_Name;
1120                      --  The name of the package, if any, where the associative
1121                      --  array value is.
1122
1123                      Orig_Package : Package_Id := No_Package;
1124                      --  The id of the package, if any, where the associative
1125                      --  array value is.
1126
1127                      New_Element : Array_Element_Id := No_Array_Element;
1128                      --  Id of a new array element created
1129
1130                      Prev_Element : Array_Element_Id := No_Array_Element;
1131                      --  Last new element id created
1132
1133                      Orig_Element : Array_Element_Id := No_Array_Element;
1134                      --  Current array element in the original associative
1135                      --  array.
1136
1137                      Next_Element : Array_Element_Id := No_Array_Element;
1138                      --  Id of the array element that follows the new element.
1139                      --  This is not always nil, because values for the
1140                      --  associative array attribute may already have been
1141                      --  declared, and the array elements declared are reused.
1142
1143                   begin
1144                      --  First, find if the associative array attribute already
1145                      --  has elements declared.
1146
1147                      if Pkg /= No_Package then
1148                         New_Array := Packages.Table (Pkg).Decl.Arrays;
1149
1150                      else
1151                         New_Array := Projects.Table (Project).Decl.Arrays;
1152                      end if;
1153
1154                      while New_Array /= No_Array and then
1155                            Arrays.Table (New_Array).Name /= Current_Item_Name
1156                      loop
1157                         New_Array := Arrays.Table (New_Array).Next;
1158                      end loop;
1159
1160                      --  If the attribute has never been declared add new entry
1161                      --  in the arrays of the project/package and link it.
1162
1163                      if New_Array = No_Array then
1164                         Arrays.Increment_Last;
1165                         New_Array := Arrays.Last;
1166
1167                         if Pkg /= No_Package then
1168                            Arrays.Table (New_Array) :=
1169                              (Name  => Current_Item_Name,
1170                               Value => No_Array_Element,
1171                               Next  => Packages.Table (Pkg).Decl.Arrays);
1172                            Packages.Table (Pkg).Decl.Arrays := New_Array;
1173
1174                         else
1175                            Arrays.Table (New_Array) :=
1176                              (Name  => Current_Item_Name,
1177                               Value => No_Array_Element,
1178                               Next  => Projects.Table (Project).Decl.Arrays);
1179                            Projects.Table (Project).Decl.Arrays := New_Array;
1180                         end if;
1181                      end if;
1182
1183                      --  Find the project where the value is declared
1184
1185                      Orig_Project_Name :=
1186                        Name_Of (Associative_Project_Of (Current_Item));
1187
1188                      for Index in Projects.First .. Projects.Last loop
1189                         if Projects.Table (Index).Name = Orig_Project_Name then
1190                            Orig_Project := Index;
1191                            exit;
1192                         end if;
1193                      end loop;
1194
1195                      pragma Assert (Orig_Project /= No_Project,
1196                                     "original project not found");
1197
1198                      if Associative_Package_Of (Current_Item) = Empty_Node then
1199                         Orig_Array :=
1200                           Projects.Table (Orig_Project).Decl.Arrays;
1201
1202                      else
1203                         --  If in a package, find the package where the
1204                         --  value is declared.
1205
1206                         Orig_Package_Name :=
1207                           Name_Of (Associative_Package_Of (Current_Item));
1208                         Orig_Package :=
1209                           Projects.Table (Orig_Project).Decl.Packages;
1210                         pragma Assert (Orig_Package /= No_Package,
1211                                        "original package not found");
1212
1213                         while Packages.Table (Orig_Package).Name /=
1214                           Orig_Package_Name
1215                         loop
1216                            Orig_Package := Packages.Table (Orig_Package).Next;
1217                            pragma Assert (Orig_Package /= No_Package,
1218                                           "original package not found");
1219                         end loop;
1220
1221                         Orig_Array :=
1222                           Packages.Table (Orig_Package).Decl.Arrays;
1223                      end if;
1224
1225                      --  Now look for the array
1226
1227                      while Orig_Array /= No_Array and then
1228                            Arrays.Table (Orig_Array).Name /= Current_Item_Name
1229                      loop
1230                         Orig_Array := Arrays.Table (Orig_Array).Next;
1231                      end loop;
1232
1233                      if Orig_Array = No_Array then
1234                         if Error_Report = null then
1235                            Error_Msg
1236                              ("associative array value cannot be found",
1237                               Location_Of (Current_Item));
1238
1239                         else
1240                            Error_Report
1241                              ("associative array value cannot be found",
1242                               Project);
1243                         end if;
1244
1245                      else
1246                         Orig_Element := Arrays.Table (Orig_Array).Value;
1247
1248                         --  Copy each array element
1249
1250                         while Orig_Element /= No_Array_Element loop
1251                            --  If it is the first element ...
1252
1253                            if Prev_Element = No_Array_Element then
1254                               --  And there is no array element declared yet,
1255                               --  create a new first array element.
1256
1257                               if Arrays.Table (New_Array).Value =
1258                                                               No_Array_Element
1259                               then
1260                                  Array_Elements.Increment_Last;
1261                                  New_Element := Array_Elements.Last;
1262                                  Arrays.Table (New_Array).Value := New_Element;
1263                                  Next_Element := No_Array_Element;
1264
1265                               --  Otherwise, the new element is the first
1266
1267                               else
1268                                  New_Element := Arrays.Table (New_Array).Value;
1269                                  Next_Element :=
1270                                    Array_Elements.Table (New_Element).Next;
1271                               end if;
1272
1273                            --  Otherwise, reuse an existing element, or create
1274                            --  one if necessary.
1275
1276                            else
1277                               Next_Element :=
1278                                 Array_Elements.Table (Prev_Element).Next;
1279
1280                               if Next_Element = No_Array_Element then
1281                                  Array_Elements.Increment_Last;
1282                                  New_Element := Array_Elements.Last;
1283
1284                               else
1285                                  New_Element := Next_Element;
1286                                  Next_Element :=
1287                                    Array_Elements.Table (New_Element).Next;
1288                               end if;
1289                            end if;
1290
1291                            --  Copy the value of the element
1292
1293                            Array_Elements.Table (New_Element) :=
1294                              Array_Elements.Table (Orig_Element);
1295                            Array_Elements.Table (New_Element).Value.Project :=
1296                              Project;
1297
1298                            --  Adjust the Next link
1299
1300                            Array_Elements.Table (New_Element).Next :=
1301                              Next_Element;
1302
1303                            --  Adjust the previous id for the next element
1304
1305                            Prev_Element := New_Element;
1306
1307                            --  Go to the next element in the original array
1308                            Orig_Element :=
1309                              Array_Elements.Table (Orig_Element).Next;
1310                         end loop;
1311
1312                         --  Make sure that the array ends here, in case there
1313                         --  previously a greater number of elements.
1314
1315                         Array_Elements.Table (New_Element).Next :=
1316                           No_Array_Element;
1317                      end if;
1318                   end;
1319
1320                --  Declarations other that full associative arrays
1321
1322                else
1323                   declare
1324                      New_Value : constant Variable_Value :=
1325                        Expression
1326                          (Project           => Project,
1327                           From_Project_Node => From_Project_Node,
1328                           Pkg               => Pkg,
1329                           First_Term        =>
1330                             Tree.First_Term (Expression_Of
1331                                                         (Current_Item)),
1332                           Kind              =>
1333                             Expression_Kind_Of (Current_Item));
1334                      --  The expression value
1335
1336                      The_Variable : Variable_Id := No_Variable;
1337
1338                      Current_Item_Name : constant Name_Id :=
1339                        Name_Of (Current_Item);
1340
1341                   begin
1342                      --  Process a typed variable declaration
1343
1344                      if
1345                        Kind_Of (Current_Item) = N_Typed_Variable_Declaration
1346                      then
1347                         --  Report an error for an empty string
1348
1349                         if New_Value.Value = Empty_String then
1350                            Error_Msg_Name_1 := Name_Of (Current_Item);
1351
1352                            if Error_Report = null then
1353                               Error_Msg
1354                                 ("no value defined for %",
1355                                  Location_Of (Current_Item));
1356
1357                            else
1358                               Error_Report
1359                                 ("no value defined for " &
1360                                  Get_Name_String (Error_Msg_Name_1),
1361                                  Project);
1362                            end if;
1363
1364                         else
1365                            declare
1366                               Current_String : Project_Node_Id :=
1367                                 First_Literal_String
1368                                   (String_Type_Of
1369                                        (Current_Item));
1370
1371                            begin
1372                               --  Loop through all the valid strings for
1373                               --  the string type and compare to the string
1374                               --  value.
1375
1376                               while Current_String /= Empty_Node
1377                                 and then String_Value_Of (Current_String) /=
1378                                 New_Value.Value
1379                               loop
1380                                  Current_String :=
1381                                    Next_Literal_String (Current_String);
1382                               end loop;
1383
1384                               --  Report an error if the string value is not
1385                               --  one for the string type.
1386
1387                               if Current_String = Empty_Node then
1388                                  Error_Msg_Name_1 := New_Value.Value;
1389                                  Error_Msg_Name_2 := Name_Of (Current_Item);
1390
1391                                  if Error_Report = null then
1392                                     Error_Msg
1393                                       ("value { is illegal for typed string %",
1394                                        Location_Of (Current_Item));
1395
1396                                  else
1397                                     Error_Report
1398                                       ("value """ &
1399                                        Get_Name_String (Error_Msg_Name_1) &
1400                                        """ is illegal for typed string """ &
1401                                        Get_Name_String (Error_Msg_Name_2) &
1402                                        """",
1403                                        Project);
1404                                  end if;
1405                               end if;
1406                            end;
1407                         end if;
1408                      end if;
1409
1410                      if Kind_Of (Current_Item) /= N_Attribute_Declaration
1411                        or else
1412                          Associative_Array_Index_Of (Current_Item) = No_Name
1413                      then
1414                         --  Case of a variable declaration or of a not
1415                         --  associative array attribute.
1416
1417                         --  First, find the list where to find the variable
1418                         --  or attribute.
1419
1420                         if
1421                           Kind_Of (Current_Item) = N_Attribute_Declaration
1422                         then
1423                            if Pkg /= No_Package then
1424                               The_Variable :=
1425                                 Packages.Table (Pkg).Decl.Attributes;
1426
1427                            else
1428                               The_Variable :=
1429                                 Projects.Table (Project).Decl.Attributes;
1430                            end if;
1431
1432                         else
1433                            if Pkg /= No_Package then
1434                               The_Variable :=
1435                                 Packages.Table (Pkg).Decl.Variables;
1436
1437                            else
1438                               The_Variable :=
1439                                 Projects.Table (Project).Decl.Variables;
1440                            end if;
1441
1442                         end if;
1443
1444                         --  Loop through the list, to find if it has already
1445                         --  been declared.
1446
1447                         while
1448                           The_Variable /= No_Variable
1449                           and then
1450                         Variable_Elements.Table (The_Variable).Name /=
1451                           Current_Item_Name
1452                         loop
1453                            The_Variable :=
1454                              Variable_Elements.Table (The_Variable).Next;
1455                         end loop;
1456
1457                         --  If it has not been declared, create a new entry
1458                         --  in the list.
1459
1460                         if The_Variable = No_Variable then
1461                            --  All single string attribute should already have
1462                            --  been declared with a default empty string value.
1463
1464                            pragma Assert
1465                              (Kind_Of (Current_Item) /=
1466                                 N_Attribute_Declaration,
1467                               "illegal attribute declaration");
1468
1469                            Variable_Elements.Increment_Last;
1470                            The_Variable := Variable_Elements.Last;
1471
1472                            --  Put the new variable in the appropriate list
1473
1474                            if Pkg /= No_Package then
1475                               Variable_Elements.Table (The_Variable) :=
1476                                 (Next    =>
1477                                    Packages.Table (Pkg).Decl.Variables,
1478                                  Name    => Current_Item_Name,
1479                                  Value   => New_Value);
1480                               Packages.Table (Pkg).Decl.Variables :=
1481                                 The_Variable;
1482
1483                            else
1484                               Variable_Elements.Table (The_Variable) :=
1485                                 (Next    =>
1486                                    Projects.Table (Project).Decl.Variables,
1487                                  Name    => Current_Item_Name,
1488                                  Value   => New_Value);
1489                               Projects.Table (Project).Decl.Variables :=
1490                                 The_Variable;
1491                            end if;
1492
1493                         --  If the variable/attribute has already been
1494                         --  declared, just change the value.
1495
1496                         else
1497                            Variable_Elements.Table (The_Variable).Value :=
1498                              New_Value;
1499
1500                         end if;
1501
1502                      else
1503                         --  Associative array attribute
1504
1505                         --  Get the string index
1506
1507                         Get_Name_String
1508                           (Associative_Array_Index_Of (Current_Item));
1509
1510                         --  Put in lower case, if necessary
1511
1512                         if Case_Insensitive (Current_Item) then
1513                            GNAT.Case_Util.To_Lower
1514                                             (Name_Buffer (1 .. Name_Len));
1515                         end if;
1516
1517                         declare
1518                            The_Array : Array_Id;
1519
1520                            The_Array_Element : Array_Element_Id :=
1521                              No_Array_Element;
1522
1523                            Index_Name : constant Name_Id := Name_Find;
1524                            --  The name id of the index
1525
1526                         begin
1527                            --  Look for the array in the appropriate list
1528
1529                            if Pkg /= No_Package then
1530                               The_Array := Packages.Table (Pkg).Decl.Arrays;
1531
1532                            else
1533                               The_Array := Projects.Table
1534                                              (Project).Decl.Arrays;
1535                            end if;
1536
1537                            while
1538                              The_Array /= No_Array
1539                              and then Arrays.Table (The_Array).Name /=
1540                              Current_Item_Name
1541                            loop
1542                               The_Array := Arrays.Table (The_Array).Next;
1543                            end loop;
1544
1545                            --  If the array cannot be found, create a new
1546                            --  entry in the list. As The_Array_Element is
1547                            --  initialized to No_Array_Element, a new element
1548                            --  will be created automatically later.
1549
1550                            if The_Array = No_Array then
1551                               Arrays.Increment_Last;
1552                               The_Array := Arrays.Last;
1553
1554                               if Pkg /= No_Package then
1555                                  Arrays.Table (The_Array) :=
1556                                    (Name  => Current_Item_Name,
1557                                     Value => No_Array_Element,
1558                                     Next  => Packages.Table (Pkg).Decl.Arrays);
1559                                  Packages.Table (Pkg).Decl.Arrays := The_Array;
1560
1561                               else
1562                                  Arrays.Table (The_Array) :=
1563                                    (Name  => Current_Item_Name,
1564                                     Value => No_Array_Element,
1565                                     Next  =>
1566                                       Projects.Table (Project).Decl.Arrays);
1567                                  Projects.Table (Project).Decl.Arrays :=
1568                                    The_Array;
1569                               end if;
1570
1571                            --  Otherwise, initialize The_Array_Element as the
1572                            --  head of the element list.
1573
1574                            else
1575                               The_Array_Element :=
1576                                 Arrays.Table (The_Array).Value;
1577                            end if;
1578
1579                            --  Look in the list, if any, to find an element
1580                            --  with the same index.
1581
1582                            while The_Array_Element /= No_Array_Element
1583                              and then
1584                            Array_Elements.Table (The_Array_Element).Index /=
1585                              Index_Name
1586                            loop
1587                               The_Array_Element :=
1588                                 Array_Elements.Table (The_Array_Element).Next;
1589                            end loop;
1590
1591                            --  If no such element were found, create a new
1592                            --  one and insert it in the element list, with
1593                            --  the propoer value.
1594
1595                            if The_Array_Element = No_Array_Element then
1596                               Array_Elements.Increment_Last;
1597                               The_Array_Element := Array_Elements.Last;
1598
1599                               Array_Elements.Table (The_Array_Element) :=
1600                                 (Index  => Index_Name,
1601                                  Src_Index => Source_Index_Of (Current_Item),
1602                                  Index_Case_Sensitive =>
1603                                  not Case_Insensitive (Current_Item),
1604                                  Value  => New_Value,
1605                                  Next   => Arrays.Table (The_Array).Value);
1606                               Arrays.Table (The_Array).Value :=
1607                                 The_Array_Element;
1608
1609                            --  An element with the same index already exists,
1610                            --  just replace its value with the new one.
1611
1612                            else
1613                               Array_Elements.Table (The_Array_Element).Value :=
1614                                 New_Value;
1615                            end if;
1616                         end;
1617                      end if;
1618                   end;
1619                end if;
1620
1621             when N_Case_Construction =>
1622                declare
1623                   The_Project   : Project_Id      := Project;
1624                   --  The id of the project of the case variable
1625
1626                   The_Package   : Package_Id      := Pkg;
1627                   --  The id of the package, if any, of the case variable
1628
1629                   The_Variable  : Variable_Value  := Nil_Variable_Value;
1630                   --  The case variable
1631
1632                   Case_Value    : Name_Id         := No_Name;
1633                   --  The case variable value
1634
1635                   Case_Item     : Project_Node_Id := Empty_Node;
1636                   Choice_String : Project_Node_Id := Empty_Node;
1637                   Decl_Item     : Project_Node_Id := Empty_Node;
1638
1639                begin
1640                   declare
1641                      Variable_Node : constant Project_Node_Id :=
1642                                        Case_Variable_Reference_Of
1643                                          (Current_Item);
1644
1645                      Var_Id : Variable_Id := No_Variable;
1646                      Name   : Name_Id     := No_Name;
1647
1648                   begin
1649                      --  If a project were specified for the case variable,
1650                      --  get its id.
1651
1652                      if Project_Node_Of (Variable_Node) /= Empty_Node then
1653                         Name := Name_Of (Project_Node_Of (Variable_Node));
1654                         The_Project :=
1655                           Imported_Or_Extended_Project_From (Project, Name);
1656                      end if;
1657
1658                      --  If a package were specified for the case variable,
1659                      --  get its id.
1660
1661                      if Package_Node_Of (Variable_Node) /= Empty_Node then
1662                         Name := Name_Of (Package_Node_Of (Variable_Node));
1663                         The_Package := Package_From (The_Project, Name);
1664                      end if;
1665
1666                      Name := Name_Of (Variable_Node);
1667
1668                      --  First, look for the case variable into the package,
1669                      --  if any.
1670
1671                      if The_Package /= No_Package then
1672                         Var_Id := Packages.Table (The_Package).Decl.Variables;
1673                         Name := Name_Of (Variable_Node);
1674                         while Var_Id /= No_Variable
1675                           and then
1676                             Variable_Elements.Table (Var_Id).Name /= Name
1677                         loop
1678                            Var_Id := Variable_Elements.Table (Var_Id).Next;
1679                         end loop;
1680                      end if;
1681
1682                      --  If not found in the package, or if there is no
1683                      --  package, look at the project level.
1684
1685                      if Var_Id = No_Variable
1686                        and then Package_Node_Of (Variable_Node) = Empty_Node
1687                      then
1688                         Var_Id := Projects.Table (The_Project).Decl.Variables;
1689                         while Var_Id /= No_Variable
1690                           and then
1691                             Variable_Elements.Table (Var_Id).Name /= Name
1692                         loop
1693                            Var_Id := Variable_Elements.Table (Var_Id).Next;
1694                         end loop;
1695                      end if;
1696
1697                      if Var_Id = No_Variable then
1698
1699                         --  Should never happen, because this has already been
1700                         --  checked during parsing.
1701
1702                         Write_Line ("variable """ &
1703                                     Get_Name_String (Name) &
1704                                     """ not found");
1705                         raise Program_Error;
1706                      end if;
1707
1708                      --  Get the case variable
1709
1710                      The_Variable := Variable_Elements.Table (Var_Id).Value;
1711
1712                      if The_Variable.Kind /= Single then
1713
1714                         --  Should never happen, because this has already been
1715                         --  checked during parsing.
1716
1717                         Write_Line ("variable""" &
1718                                     Get_Name_String (Name) &
1719                                     """ is not a single string variable");
1720                         raise Program_Error;
1721                      end if;
1722
1723                      --  Get the case variable value
1724                      Case_Value := The_Variable.Value;
1725                   end;
1726
1727                   --  Now look into all the case items of the case construction
1728
1729                   Case_Item := First_Case_Item_Of (Current_Item);
1730                   Case_Item_Loop :
1731                      while Case_Item /= Empty_Node loop
1732                         Choice_String := First_Choice_Of (Case_Item);
1733
1734                         --  When Choice_String is nil, it means that it is
1735                         --  the "when others =>" alternative.
1736
1737                         if Choice_String = Empty_Node then
1738                            Decl_Item := First_Declarative_Item_Of (Case_Item);
1739                            exit Case_Item_Loop;
1740                         end if;
1741
1742                         --  Look into all the alternative of this case item
1743
1744                         Choice_Loop :
1745                            while Choice_String /= Empty_Node loop
1746                               if
1747                                 Case_Value = String_Value_Of (Choice_String)
1748                               then
1749                                  Decl_Item :=
1750                                    First_Declarative_Item_Of (Case_Item);
1751                                  exit Case_Item_Loop;
1752                               end if;
1753
1754                               Choice_String :=
1755                                 Next_Literal_String (Choice_String);
1756                            end loop Choice_Loop;
1757                         Case_Item := Next_Case_Item (Case_Item);
1758                      end loop Case_Item_Loop;
1759
1760                   --  If there is an alternative, then we process it
1761
1762                   if Decl_Item /= Empty_Node then
1763                      Process_Declarative_Items
1764                        (Project           => Project,
1765                         From_Project_Node => From_Project_Node,
1766                         Pkg               => Pkg,
1767                         Item              => Decl_Item);
1768                   end if;
1769                end;
1770
1771             when others =>
1772
1773                --  Should never happen
1774
1775                Write_Line ("Illegal declarative item: " &
1776                            Project_Node_Kind'Image (Kind_Of (Current_Item)));
1777                raise Program_Error;
1778          end case;
1779       end loop;
1780    end Process_Declarative_Items;
1781
1782    ---------------------
1783    -- Recursive_Check --
1784    ---------------------
1785
1786    procedure Recursive_Check
1787      (Project           : Project_Id;
1788       Process_Languages : Languages_Processed;
1789       Follow_Links      : Boolean)
1790    is
1791       Data                  : Project_Data;
1792       Imported_Project_List : Project_List := Empty_Project_List;
1793
1794    begin
1795       --  Do nothing if Project is No_Project, or Project has already
1796       --  been marked as checked.
1797
1798       if Project /= No_Project
1799         and then not Projects.Table (Project).Checked
1800       then
1801          --  Mark project as checked, to avoid infinite recursion in
1802          --  ill-formed trees, where a project imports itself.
1803
1804          Projects.Table (Project).Checked := True;
1805
1806          Data := Projects.Table (Project);
1807
1808          --  Call itself for a possible extended project.
1809          --  (if there is no extended project, then nothing happens).
1810
1811          Recursive_Check (Data.Extends, Process_Languages, Follow_Links);
1812
1813          --  Call itself for all imported projects
1814
1815          Imported_Project_List := Data.Imported_Projects;
1816          while Imported_Project_List /= Empty_Project_List loop
1817             Recursive_Check
1818               (Project_Lists.Table (Imported_Project_List).Project,
1819                Process_Languages, Follow_Links);
1820             Imported_Project_List :=
1821               Project_Lists.Table (Imported_Project_List).Next;
1822          end loop;
1823
1824          if Opt.Verbose_Mode then
1825             Write_Str ("Checking project file """);
1826             Write_Str (Get_Name_String (Data.Name));
1827             Write_Line ("""");
1828          end if;
1829
1830          case Process_Languages is
1831             when Ada_Language =>
1832                Prj.Nmsc.Ada_Check (Project, Error_Report, Follow_Links);
1833
1834             when Other_Languages =>
1835                Prj.Nmsc.Other_Languages_Check (Project, Error_Report);
1836
1837             when All_Languages =>
1838                Prj.Nmsc.Ada_Check (Project, Error_Report, Follow_Links);
1839                Prj.Nmsc.Other_Languages_Check (Project, Error_Report);
1840
1841          end case;
1842       end if;
1843    end Recursive_Check;
1844
1845    -----------------------
1846    -- Recursive_Process --
1847    -----------------------
1848
1849    procedure Recursive_Process
1850      (Project           : out Project_Id;
1851       From_Project_Node : Project_Node_Id;
1852       Extended_By       : Project_Id)
1853    is
1854       With_Clause : Project_Node_Id;
1855
1856    begin
1857       if From_Project_Node = Empty_Node then
1858          Project := No_Project;
1859
1860       else
1861          declare
1862             Processed_Data   : Project_Data     := Empty_Project;
1863             Imported         : Project_List     := Empty_Project_List;
1864             Declaration_Node : Project_Node_Id  := Empty_Node;
1865             Name             : constant Name_Id := Name_Of (From_Project_Node);
1866
1867          begin
1868             Project := Processed_Projects.Get (Name);
1869
1870             if Project /= No_Project then
1871                return;
1872             end if;
1873
1874             Projects.Increment_Last;
1875             Project := Projects.Last;
1876             Processed_Projects.Set (Name, Project);
1877
1878             Processed_Data.Name := Name;
1879
1880             Get_Name_String (Name);
1881
1882             --  If name starts with the virtual prefix, flag the project as
1883             --  being a virtual extending project.
1884
1885             if Name_Len > Virtual_Prefix'Length
1886               and then Name_Buffer (1 .. Virtual_Prefix'Length) =
1887                          Virtual_Prefix
1888             then
1889                Processed_Data.Virtual := True;
1890             end if;
1891
1892             Processed_Data.Display_Path_Name :=
1893               Path_Name_Of (From_Project_Node);
1894             Get_Name_String (Processed_Data.Display_Path_Name);
1895             Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1896             Processed_Data.Path_Name := Name_Find;
1897
1898             Processed_Data.Location := Location_Of (From_Project_Node);
1899
1900             Processed_Data.Display_Directory :=
1901               Directory_Of (From_Project_Node);
1902             Get_Name_String (Processed_Data.Display_Directory);
1903             Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1904             Processed_Data.Directory := Name_Find;
1905
1906             Processed_Data.Extended_By := Extended_By;
1907             Processed_Data.Naming      := Standard_Naming_Data;
1908
1909             Add_Attributes (Project, Processed_Data.Decl, Attribute_First);
1910             With_Clause := First_With_Clause_Of (From_Project_Node);
1911
1912             while With_Clause /= Empty_Node loop
1913                declare
1914                   New_Project : Project_Id;
1915                   New_Data    : Project_Data;
1916
1917                begin
1918                   Recursive_Process
1919                     (Project           => New_Project,
1920                      From_Project_Node => Project_Node_Of (With_Clause),
1921                      Extended_By       => No_Project);
1922                   New_Data := Projects.Table (New_Project);
1923
1924                   --  If we were the first project to import it,
1925                   --  set First_Referred_By to us.
1926
1927                   if New_Data.First_Referred_By = No_Project then
1928                      New_Data.First_Referred_By := Project;
1929                      Projects.Table (New_Project) := New_Data;
1930                   end if;
1931
1932                   --  Add this project to our list of imported projects
1933
1934                   Project_Lists.Increment_Last;
1935                   Project_Lists.Table (Project_Lists.Last) :=
1936                     (Project => New_Project, Next => Empty_Project_List);
1937
1938                   --  Imported is the id of the last imported project.
1939                   --  If it is nil, then this imported project is our first.
1940
1941                   if Imported = Empty_Project_List then
1942                      Processed_Data.Imported_Projects := Project_Lists.Last;
1943
1944                   else
1945                      Project_Lists.Table (Imported).Next := Project_Lists.Last;
1946                   end if;
1947
1948                   Imported := Project_Lists.Last;
1949
1950                   With_Clause := Next_With_Clause_Of (With_Clause);
1951                end;
1952             end loop;
1953
1954             Declaration_Node := Project_Declaration_Of (From_Project_Node);
1955
1956             Recursive_Process
1957               (Project           => Processed_Data.Extends,
1958                From_Project_Node => Extended_Project_Of (Declaration_Node),
1959                Extended_By       => Project);
1960
1961             Projects.Table (Project) := Processed_Data;
1962
1963             Process_Declarative_Items
1964               (Project           => Project,
1965                From_Project_Node => From_Project_Node,
1966                Pkg               => No_Package,
1967                Item              => First_Declarative_Item_Of
1968                                       (Declaration_Node));
1969
1970             --  If it is an extending project, inherit all packages
1971             --  from the extended project that are not explicitely defined
1972             --  or renamed. Also inherit the languages, if attribute Languages
1973             --  is not explicitely defined.
1974
1975             if Processed_Data.Extends /= No_Project then
1976                Processed_Data := Projects.Table (Project);
1977
1978                declare
1979                   Extended_Pkg : Package_Id :=
1980                                    Projects.Table
1981                                      (Processed_Data.Extends).Decl.Packages;
1982                   Current_Pkg : Package_Id;
1983                   Element     : Package_Element;
1984                   First       : constant Package_Id :=
1985                                   Processed_Data.Decl.Packages;
1986                   Attribute1  : Variable_Id;
1987                   Attribute2  : Variable_Id;
1988                   Attr_Value1 : Variable;
1989                   Attr_Value2  : Variable;
1990
1991                begin
1992                   while Extended_Pkg /= No_Package loop
1993                      Element := Packages.Table (Extended_Pkg);
1994
1995                      Current_Pkg := First;
1996
1997                      loop
1998                         exit when Current_Pkg = No_Package
1999                           or else Packages.Table (Current_Pkg).Name
2000                                      = Element.Name;
2001                         Current_Pkg := Packages.Table (Current_Pkg).Next;
2002                      end loop;
2003
2004                      if Current_Pkg = No_Package then
2005                         Packages.Increment_Last;
2006                         Current_Pkg := Packages.Last;
2007                         Packages.Table (Current_Pkg) :=
2008                           (Name   => Element.Name,
2009                            Decl   => Element.Decl,
2010                            Parent => No_Package,
2011                            Next   => Processed_Data.Decl.Packages);
2012                         Processed_Data.Decl.Packages := Current_Pkg;
2013                      end if;
2014
2015                      Extended_Pkg := Element.Next;
2016                   end loop;
2017
2018                   --  Check if attribute Languages is declared in the
2019                   --  extending project.
2020
2021                   Attribute1 := Processed_Data.Decl.Attributes;
2022                   while Attribute1 /= No_Variable loop
2023                      Attr_Value1 := Variable_Elements.Table (Attribute1);
2024                      exit when Attr_Value1.Name = Snames.Name_Languages;
2025                      Attribute1 := Attr_Value1.Next;
2026                   end loop;
2027
2028                   if Attribute1 = No_Variable or else
2029                      Attr_Value1.Value.Default
2030                   then
2031                      --  Attribute Languages is not declared in the extending
2032                      --  project. Check if it is declared in the project being
2033                      --  extended.
2034
2035                      Attribute2 :=
2036                        Projects.Table (Processed_Data.Extends).Decl.Attributes;
2037
2038                      while Attribute2 /= No_Variable loop
2039                         Attr_Value2 := Variable_Elements.Table (Attribute2);
2040                         exit when Attr_Value2.Name = Snames.Name_Languages;
2041                         Attribute2 := Attr_Value2.Next;
2042                      end loop;
2043
2044                      if Attribute2 /= No_Variable and then
2045                         not Attr_Value2.Value.Default
2046                      then
2047                         --  As attribute Languages is declared in the project
2048                         --  being extended, copy its value for the extending
2049                         --  project.
2050
2051                         if Attribute1 = No_Variable then
2052                            Variable_Elements.Increment_Last;
2053                            Attribute1 := Variable_Elements.Last;
2054                            Attr_Value1.Next := Processed_Data.Decl.Attributes;
2055                            Processed_Data.Decl.Attributes := Attribute1;
2056                         end if;
2057
2058                         Attr_Value1.Name := Snames.Name_Languages;
2059                         Attr_Value1.Value := Attr_Value2.Value;
2060                         Variable_Elements.Table (Attribute1) := Attr_Value1;
2061                      end if;
2062                   end if;
2063                end;
2064
2065                Projects.Table (Project) := Processed_Data;
2066             end if;
2067          end;
2068       end if;
2069    end Recursive_Process;
2070
2071 end Prj.Proc;