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