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