gcc/ada/prj-proc.adb

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