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