gcc/ada/prj-proc.adb

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