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 --                            $Revision$
  10 --                                                                          --
  11 --             Copyright (C) 2001 Free Software Foundation, Inc.            --
  12 --                                                                          --
  13 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19 -- for  more details.  You should have  received  a copy of the GNU General --
  20 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22 -- MA 02111-1307, USA.                                                      --
  23 --                                                                          --
  24 -- GNAT was originally developed  by the GNAT team at  New York University. --
  25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  26 --                                                                          --
  27 ------------------------------------------------------------------------------
  28
  29 with Errout;   use Errout;
  30 with Namet;    use Namet;
  31 with Opt;
  32 with Output;   use Output;
  33 with Prj.Attr; use Prj.Attr;
  34 with Prj.Com;  use Prj.Com;
  35 with Prj.Ext;  use Prj.Ext;
  36 with Prj.Nmsc; use Prj.Nmsc;
  37 with Stringt;  use Stringt;
  38
  39 with 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 String_Id; Str : String_Id);
  56    --  Concatenate two strings and returns another string if both
  57    --  arguments are not null string.
  58
  59    procedure Add_Attributes
  60      (Decl     : in out Declarations;
  61       First    : Attribute_Node_Id);
  62    --  Add all attributes, starting with First, with their default
  63    --  values to the package or project with declarations Decl.
  64
  65    function Expression
  66      (Project           : Project_Id;
  67       From_Project_Node : Project_Node_Id;
  68       Pkg               : Package_Id;
  69       First_Term        : Project_Node_Id;
  70       Kind              : Variable_Kind)
  71       return              Variable_Value;
  72    --  From N_Expression project node From_Project_Node, compute the value
  73    --  of an expression and return it as a Variable_Value.
  74
  75    function Imported_Or_Modified_Project_From
  76      (Project   : Project_Id;
  77       With_Name : Name_Id)
  78       return      Project_Id;
  79    --  Find an imported or modified project of Project whose name is With_Name.
  80
  81    function Package_From
  82      (Project   : Project_Id;
  83       With_Name : Name_Id)
  84       return      Package_Id;
  85    --  Find the package of Project whose name is With_Name.
  86
  87    procedure Process_Declarative_Items
  88      (Project           : Project_Id;
  89       From_Project_Node : Project_Node_Id;
  90       Pkg               : Package_Id;
  91       Item              : Project_Node_Id);
  92    --  Process declarative items starting with From_Project_Node, and put them
  93    --  in declarations Decl. This is a recursive procedure; it calls itself for
  94    --  a package declaration or a case construction.
  95
  96    procedure Recursive_Process
  97      (Project           : out Project_Id;
  98       From_Project_Node : Project_Node_Id;
  99       Modified_By       : Project_Id);
 100    --  Process project with node From_Project_Node in the tree.
 101    --  Do nothing if From_Project_Node is Empty_Node.
 102    --  If project has already been processed, simply return its project id.
 103    --  Otherwise create a new project id, mark it as processed, call itself
 104    --  recursively for all imported projects and a modified project, if any.
 105    --  Then process the declarative items of the project.
 106
 107    procedure Check (Project : in out Project_Id);
 108    --  Set all projects to not checked, then call Recursive_Check for
 109    --  the main project Project.
 110    --  Project is set to No_Project if errors occurred.
 111
 112    procedure Recursive_Check (Project : Project_Id);
 113    --  If Project is marked as not checked, mark it as checked,
 114    --  call Check_Naming_Scheme for the project, then call itself
 115    --  for a possible modified project and all the imported projects
 116    --  of Project.
 117
 118    ---------
 119    -- Add --
 120    ---------
 121
 122    procedure Add (To_Exp : in out String_Id; Str : String_Id) is
 123    begin
 124       if To_Exp = Types.No_String or else String_Length (To_Exp) = 0 then
 125
 126          --  To_Exp is nil or empty. The result is Str.
 127
 128          To_Exp := Str;
 129
 130       --  If Str is nil, then do not change To_Ext
 131
 132       elsif Str /= No_String then
 133          Start_String (To_Exp);
 134          Store_String_Chars (Str);
 135          To_Exp := End_String;
 136       end if;
 137    end Add;
 138
 139    --------------------
 140    -- Add_Attributes --
 141    --------------------
 142
 143    procedure Add_Attributes
 144      (Decl           : in out Declarations;
 145       First          : Attribute_Node_Id) is
 146       The_Attribute  : Attribute_Node_Id := First;
 147       Attribute_Data : Attribute_Record;
 148
 149    begin
 150       while The_Attribute /= Empty_Attribute loop
 151          Attribute_Data := Attributes.Table (The_Attribute);
 152
 153          if Attribute_Data.Kind_2 /= Associative_Array then
 154             declare
 155                New_Attribute : Variable_Value;
 156
 157             begin
 158                case Attribute_Data.Kind_1 is
 159
 160                   --  Undefined should not happen
 161
 162                   when Undefined =>
 163                      pragma Assert
 164                        (False, "attribute with an undefined kind");
 165                      raise Program_Error;
 166
 167                   --  Single attributes have a default value of empty string
 168
 169                   when Single =>
 170                      New_Attribute :=
 171                        (Kind     => Single,
 172                         Location => No_Location,
 173                         Default  => True,
 174                         Value    => Empty_String);
 175
 176                   --  List attributes have a default value of nil list
 177
 178                   when List =>
 179                      New_Attribute :=
 180                        (Kind     => List,
 181                         Location => No_Location,
 182                         Default  => True,
 183                         Values   => Nil_String);
 184
 185                end case;
 186
 187                Variable_Elements.Increment_Last;
 188                Variable_Elements.Table (Variable_Elements.Last) :=
 189                  (Next  => Decl.Attributes,
 190                   Name  => Attribute_Data.Name,
 191                   Value => New_Attribute);
 192                Decl.Attributes := Variable_Elements.Last;
 193             end;
 194          end if;
 195
 196          The_Attribute := Attributes.Table (The_Attribute).Next;
 197       end loop;
 198
 199    end Add_Attributes;
 200
 201    -----------
 202    -- Check --
 203    -----------
 204
 205    procedure Check (Project : in out Project_Id) is
 206    begin
 207       --  Make sure that all projects are marked as not checked.
 208
 209       for Index in 1 .. Projects.Last loop
 210          Projects.Table (Index).Checked := False;
 211       end loop;
 212
 213       Recursive_Check (Project);
 214
 215       if Errout.Errors_Detected > 0 then
 216          Project := No_Project;
 217       end if;
 218
 219    end Check;
 220
 221    ----------------
 222    -- Expression --
 223    ----------------
 224
 225    function Expression
 226      (Project           : Project_Id;
 227       From_Project_Node : Project_Node_Id;
 228       Pkg               : Package_Id;
 229       First_Term        : Project_Node_Id;
 230       Kind              : Variable_Kind)
 231       return              Variable_Value
 232    is
 233       The_Term : Project_Node_Id := First_Term;
 234       --  The term in the expression list
 235
 236       The_Current_Term : Project_Node_Id := Empty_Node;
 237       --  The current term node id
 238
 239       Term_Kind : Variable_Kind;
 240       --  The kind of the current term
 241
 242       Result : Variable_Value (Kind => Kind);
 243       --  The returned result
 244
 245       Last : String_List_Id := Nil_String;
 246       --  Reference to the last string elements in Result, when Kind is List.
 247
 248    begin
 249       Result.Location := Location_Of (From_Project_Node);
 250
 251       --  Process each term of the expression, starting with First_Term
 252
 253       while The_Term /= Empty_Node loop
 254
 255          --  We get the term data and kind ...
 256
 257          Term_Kind := Expression_Kind_Of (The_Term);
 258
 259          The_Current_Term := Current_Term (The_Term);
 260
 261          case Kind_Of (The_Current_Term) is
 262
 263             when N_Literal_String =>
 264
 265                case Kind is
 266
 267                   when Undefined =>
 268
 269                      --  Should never happen
 270
 271                      pragma Assert (False, "Undefined expression kind");
 272                      raise Program_Error;
 273
 274                   when Single =>
 275                      Add (Result.Value, String_Value_Of (The_Current_Term));
 276
 277                   when List =>
 278
 279                      String_Elements.Increment_Last;
 280
 281                      if Last = Nil_String then
 282
 283                         --  This can happen in an expression such as
 284                         --  () & "toto"
 285
 286                         Result.Values := String_Elements.Last;
 287
 288                      else
 289                         String_Elements.Table (Last).Next :=
 290                           String_Elements.Last;
 291                      end if;
 292
 293                      Last := String_Elements.Last;
 294                      String_Elements.Table (Last) :=
 295                        (Value    => String_Value_Of (The_Current_Term),
 296                         Location => Location_Of (The_Current_Term),
 297                         Next     => Nil_String);
 298
 299                end case;
 300
 301             when N_Literal_String_List =>
 302
 303                declare
 304                   String_Node : Project_Node_Id :=
 305                                   First_Expression_In_List (The_Current_Term);
 306
 307                   Value : Variable_Value;
 308
 309                begin
 310                   if String_Node /= Empty_Node then
 311
 312                      --  If String_Node is nil, it is an empty list,
 313                      --  there is nothing to do
 314
 315                      Value := Expression
 316                        (Project           => Project,
 317                         From_Project_Node => From_Project_Node,
 318                         Pkg               => Pkg,
 319                         First_Term        => Tree.First_Term (String_Node),
 320                         Kind              => Single);
 321                      String_Elements.Increment_Last;
 322
 323                      if Result.Values = Nil_String then
 324
 325                         --  This literal string list is the first term
 326                         --  in a string list expression
 327
 328                         Result.Values := String_Elements.Last;
 329
 330                      else
 331                         String_Elements.Table (Last).Next :=
 332                           String_Elements.Last;
 333                      end if;
 334
 335                      Last := String_Elements.Last;
 336                      String_Elements.Table (Last) :=
 337                        (Value    => Value.Value,
 338                         Location => Value.Location,
 339                         Next     => Nil_String);
 340
 341                      loop
 342                         --  Add the other element of the literal string list
 343                         --  one after the other
 344
 345                         String_Node :=
 346                           Next_Expression_In_List (String_Node);
 347
 348                         exit when String_Node = Empty_Node;
 349
 350                         Value :=
 351                           Expression
 352                           (Project           => Project,
 353                            From_Project_Node => From_Project_Node,
 354                            Pkg               => Pkg,
 355                            First_Term        => Tree.First_Term (String_Node),
 356                            Kind              => Single);
 357
 358                         String_Elements.Increment_Last;
 359                         String_Elements.Table (Last).Next :=
 360                           String_Elements.Last;
 361                         Last := String_Elements.Last;
 362                         String_Elements.Table (Last) :=
 363                           (Value    => Value.Value,
 364                            Location => Value.Location,
 365                            Next     => Nil_String);
 366                      end loop;
 367
 368                   end if;
 369
 370                end;
 371
 372             when N_Variable_Reference | N_Attribute_Reference =>
 373
 374                declare
 375                   The_Project     : Project_Id  := Project;
 376                   The_Package     : Package_Id  := Pkg;
 377                   The_Name        : Name_Id     := No_Name;
 378                   The_Variable_Id : Variable_Id := No_Variable;
 379                   The_Variable    : Variable;
 380                   Term_Project    : constant Project_Node_Id :=
 381                                       Project_Node_Of (The_Current_Term);
 382                   Term_Package    : constant Project_Node_Id :=
 383                                       Package_Node_Of (The_Current_Term);
 384
 385                begin
 386                   if Term_Project /= Empty_Node and then
 387                      Term_Project /= From_Project_Node
 388                   then
 389                      --  This variable or attribute comes from another project
 390
 391                      The_Name := Name_Of (Term_Project);
 392                      The_Project := Imported_Or_Modified_Project_From
 393                        (Project => Project, With_Name => The_Name);
 394                   end if;
 395
 396                   if Term_Package /= Empty_Node then
 397
 398                      --  This is an attribute of a package
 399
 400                      The_Name := Name_Of (Term_Package);
 401                      The_Package := Projects.Table (The_Project).Decl.Packages;
 402
 403                      while The_Package /= No_Package
 404                        and then Packages.Table (The_Package).Name /= The_Name
 405                      loop
 406                         The_Package := Packages.Table (The_Package).Next;
 407                      end loop;
 408
 409                      pragma Assert
 410                        (The_Package /= No_Package,
 411                         "package not found.");
 412
 413                   elsif Kind_Of (The_Current_Term) = N_Attribute_Reference then
 414                      The_Package := No_Package;
 415                   end if;
 416
 417                   The_Name := Name_Of (The_Current_Term);
 418
 419                   if The_Package /= No_Package then
 420
 421                      --  First, if there is a package, look into the package
 422
 423                      if Kind_Of (The_Current_Term) = N_Variable_Reference then
 424                         The_Variable_Id :=
 425                           Packages.Table (The_Package).Decl.Variables;
 426
 427                      else
 428                         The_Variable_Id :=
 429                           Packages.Table (The_Package).Decl.Attributes;
 430                      end if;
 431
 432                      while The_Variable_Id /= No_Variable
 433                        and then
 434                          Variable_Elements.Table (The_Variable_Id).Name /=
 435                                                                     The_Name
 436                      loop
 437                         The_Variable_Id :=
 438                           Variable_Elements.Table (The_Variable_Id).Next;
 439                      end loop;
 440
 441                   end if;
 442
 443                   if The_Variable_Id = No_Variable then
 444
 445                      --  If we have not found it, look into the project
 446
 447                      if Kind_Of (The_Current_Term) = N_Variable_Reference then
 448                         The_Variable_Id :=
 449                           Projects.Table (The_Project).Decl.Variables;
 450
 451                      else
 452                         The_Variable_Id :=
 453                           Projects.Table (The_Project).Decl.Attributes;
 454                      end if;
 455
 456                      while The_Variable_Id /= No_Variable
 457                        and then
 458                          Variable_Elements.Table (The_Variable_Id).Name /=
 459                                                                      The_Name
 460                      loop
 461                         The_Variable_Id :=
 462                           Variable_Elements.Table (The_Variable_Id).Next;
 463                      end loop;
 464
 465                   end if;
 466
 467                   pragma Assert (The_Variable_Id /= No_Variable,
 468                                  "variable or attribute not found");
 469
 470                   The_Variable := Variable_Elements.Table (The_Variable_Id);
 471
 472                   case Kind is
 473
 474                      when Undefined =>
 475
 476                         --  Should never happen
 477
 478                         pragma Assert (False, "undefined expression kind");
 479                         null;
 480
 481                      when Single =>
 482
 483                         case The_Variable.Value.Kind is
 484
 485                            when Undefined =>
 486                               null;
 487
 488                            when Single =>
 489                               Add (Result.Value, The_Variable.Value.Value);
 490
 491                            when List =>
 492
 493                               --  Should never happen
 494
 495                               pragma Assert
 496                                 (False,
 497                                  "list cannot appear in single " &
 498                                  "string expression");
 499                               null;
 500
 501                         end case;
 502
 503                      when List =>
 504                         case The_Variable.Value.Kind is
 505
 506                            when Undefined =>
 507                               null;
 508
 509                            when Single =>
 510                               String_Elements.Increment_Last;
 511
 512                               if Last = Nil_String then
 513
 514                                  --  This can happen in an expression such as
 515                                  --  () & Var
 516
 517                                  Result.Values := String_Elements.Last;
 518
 519                               else
 520                                  String_Elements.Table (Last).Next :=
 521                                    String_Elements.Last;
 522                               end if;
 523
 524                               Last := String_Elements.Last;
 525                               String_Elements.Table (Last) :=
 526                                 (Value    => The_Variable.Value.Value,
 527                                  Location => Location_Of (The_Current_Term),
 528                                  Next     => Nil_String);
 529
 530                            when List =>
 531
 532                               declare
 533                                  The_List : String_List_Id :=
 534                                               The_Variable.Value.Values;
 535
 536                               begin
 537                                  while The_List /= Nil_String loop
 538                                     String_Elements.Increment_Last;
 539
 540                                     if Last = Nil_String then
 541                                        Result.Values := String_Elements.Last;
 542
 543                                     else
 544                                        String_Elements.Table (Last).Next :=
 545                                          String_Elements.Last;
 546
 547                                     end if;
 548
 549                                     Last := String_Elements.Last;
 550                                     String_Elements.Table (Last) :=
 551                                       (Value    =>
 552                                          String_Elements.Table
 553                                                           (The_List).Value,
 554                                        Location => Location_Of
 555                                                           (The_Current_Term),
 556                                        Next     => Nil_String);
 557                                     The_List :=
 558                                       String_Elements.Table (The_List).Next;
 559
 560                                  end loop;
 561                               end;
 562                         end case;
 563                   end case;
 564                end;
 565
 566             when N_External_Value =>
 567                String_To_Name_Buffer
 568                  (String_Value_Of (External_Reference_Of (The_Current_Term)));
 569
 570                declare
 571                   Name    : constant Name_Id  := Name_Find;
 572                   Default : String_Id         := No_String;
 573                   Value   : String_Id         := No_String;
 574
 575                   Default_Node : constant Project_Node_Id :=
 576                                    External_Default_Of (The_Current_Term);
 577
 578                begin
 579                   if Default_Node /= Empty_Node then
 580                      Default := String_Value_Of (Default_Node);
 581                   end if;
 582
 583                   Value := Prj.Ext.Value_Of (Name, Default);
 584
 585                   if Value = No_String then
 586                      if Error_Report = null then
 587                         Error_Msg
 588                           ("undefined external reference",
 589                            Location_Of (The_Current_Term));
 590
 591                      else
 592                         Error_Report
 593                           ("""" & Get_Name_String (Name) &
 594                            """ is an undefined external reference");
 595                      end if;
 596
 597                      Value := Empty_String;
 598
 599                   end if;
 600
 601                   case Kind is
 602
 603                      when Undefined =>
 604                         null;
 605
 606                      when Single =>
 607                         Add (Result.Value, Value);
 608
 609                      when List =>
 610                         String_Elements.Increment_Last;
 611
 612                         if Last = Nil_String then
 613                            Result.Values := String_Elements.Last;
 614
 615                         else
 616                            String_Elements.Table (Last).Next :=
 617                              String_Elements.Last;
 618                         end if;
 619
 620                         Last := String_Elements.Last;
 621                         String_Elements.Table (Last) :=
 622                           (Value    => Value,
 623                            Location => Location_Of (The_Current_Term),
 624                            Next     => Nil_String);
 625
 626                   end case;
 627
 628                end;
 629
 630             when others =>
 631
 632                --  Should never happen
 633
 634                pragma Assert
 635                  (False,
 636                   "illegal node kind in an expression");
 637                raise Program_Error;
 638
 639          end case;
 640
 641          The_Term := Next_Term (The_Term);
 642
 643       end loop;
 644
 645       return Result;
 646    end Expression;
 647
 648    ---------------------------------------
 649    -- Imported_Or_Modified_Project_From --
 650    ---------------------------------------
 651
 652    function Imported_Or_Modified_Project_From
 653      (Project   : Project_Id;
 654       With_Name : Name_Id)
 655       return      Project_Id
 656    is
 657       Data : constant Project_Data := Projects.Table (Project);
 658       List : Project_List          := Data.Imported_Projects;
 659
 660    begin
 661       --  First check if it is the name of a modified project
 662
 663       if Data.Modifies /= No_Project
 664         and then Projects.Table (Data.Modifies).Name = With_Name
 665       then
 666          return Data.Modifies;
 667
 668       else
 669          --  Then check the name of each imported project
 670
 671          while List /= Empty_Project_List
 672            and then
 673              Projects.Table
 674                (Project_Lists.Table (List).Project).Name /= With_Name
 675
 676          loop
 677             List := Project_Lists.Table (List).Next;
 678          end loop;
 679
 680          pragma Assert
 681            (List /= Empty_Project_List,
 682            "project not found");
 683
 684          return Project_Lists.Table (List).Project;
 685       end if;
 686    end Imported_Or_Modified_Project_From;
 687
 688    ------------------
 689    -- Package_From --
 690    ------------------
 691
 692    function Package_From
 693      (Project   : Project_Id;
 694       With_Name : Name_Id)
 695       return      Package_Id
 696    is
 697       Data   : constant Project_Data := Projects.Table (Project);
 698       Result : Package_Id := Data.Decl.Packages;
 699
 700    begin
 701       --  Check the name of each existing package of Project
 702
 703       while Result /= No_Package
 704         and then
 705         Packages.Table (Result).Name /= With_Name
 706       loop
 707          Result := Packages.Table (Result).Next;
 708       end loop;
 709
 710       if Result = No_Package then
 711          --  Should never happen
 712          Write_Line ("package """ & Get_Name_String (With_Name) &
 713                      """ not found");
 714          raise Program_Error;
 715
 716       else
 717          return Result;
 718       end if;
 719    end Package_From;
 720
 721    -------------
 722    -- Process --
 723    -------------
 724
 725    procedure Process
 726      (Project           : out Project_Id;
 727       From_Project_Node : Project_Node_Id;
 728       Report_Error      : Put_Line_Access)
 729    is
 730    begin
 731       Error_Report := Report_Error;
 732
 733       --  Make sure there is no projects in the data structure
 734
 735       Projects.Set_Last (No_Project);
 736       Processed_Projects.Reset;
 737
 738       --  And process the main project and all of the projects it depends on,
 739       --  recursively
 740
 741       Recursive_Process
 742         (Project           => Project,
 743          From_Project_Node => From_Project_Node,
 744          Modified_By       => No_Project);
 745
 746       if Errout.Errors_Detected > 0 then
 747          Project := No_Project;
 748       end if;
 749
 750       if Project /= No_Project then
 751          Check (Project);
 752       end if;
 753
 754    end Process;
 755
 756    -------------------------------
 757    -- Process_Declarative_Items --
 758    -------------------------------
 759
 760    procedure Process_Declarative_Items
 761      (Project           : Project_Id;
 762       From_Project_Node : Project_Node_Id;
 763       Pkg               : Package_Id;
 764       Item              : Project_Node_Id) is
 765
 766       Current_Declarative_Item : Project_Node_Id := Item;
 767
 768       Current_Item : Project_Node_Id := Empty_Node;
 769
 770    begin
 771       --  For each declarative item
 772
 773       while Current_Declarative_Item /= Empty_Node loop
 774
 775          --  Get its data
 776
 777          Current_Item := Current_Item_Node (Current_Declarative_Item);
 778
 779          --  And set Current_Declarative_Item to the next declarative item
 780          --  ready for the next iteration
 781
 782          Current_Declarative_Item := Next_Declarative_Item
 783                                             (Current_Declarative_Item);
 784
 785          case Kind_Of (Current_Item) is
 786
 787             when N_Package_Declaration =>
 788                Packages.Increment_Last;
 789
 790                declare
 791                   New_Pkg         : constant Package_Id := Packages.Last;
 792                   The_New_Package : Package_Element;
 793
 794                   Project_Of_Renamed_Package : constant Project_Node_Id :=
 795                                                  Project_Of_Renamed_Package_Of
 796                                                    (Current_Item);
 797
 798                begin
 799                   The_New_Package.Name := Name_Of (Current_Item);
 800
 801                   if Pkg /= No_Package then
 802                      The_New_Package.Next :=
 803                        Packages.Table (Pkg).Decl.Packages;
 804                      Packages.Table (Pkg).Decl.Packages := New_Pkg;
 805                   else
 806                      The_New_Package.Next :=
 807                        Projects.Table (Project).Decl.Packages;
 808                      Projects.Table (Project).Decl.Packages := New_Pkg;
 809                   end if;
 810
 811                   Packages.Table (New_Pkg) := The_New_Package;
 812
 813                   if Project_Of_Renamed_Package /= Empty_Node then
 814
 815                      --  Renamed package
 816
 817                      declare
 818                         Project_Name : constant Name_Id :=
 819                                          Name_Of
 820                                            (Project_Of_Renamed_Package);
 821
 822                         Renamed_Project : constant Project_Id :=
 823                                             Imported_Or_Modified_Project_From
 824                                               (Project, Project_Name);
 825
 826                         Renamed_Package : constant Package_Id :=
 827                                             Package_From
 828                                               (Renamed_Project,
 829                                                Name_Of (Current_Item));
 830
 831                      begin
 832                         Packages.Table (New_Pkg).Decl :=
 833                           Packages.Table (Renamed_Package).Decl;
 834                      end;
 835
 836                   else
 837                      --  Set the default values of the attributes
 838
 839                      Add_Attributes
 840                        (Packages.Table (New_Pkg).Decl,
 841                         Package_Attributes.Table
 842                            (Package_Id_Of (Current_Item)).First_Attribute);
 843
 844                      Process_Declarative_Items
 845                        (Project           => Project,
 846                         From_Project_Node => From_Project_Node,
 847                         Pkg               => New_Pkg,
 848                         Item              => First_Declarative_Item_Of
 849                                                              (Current_Item));
 850                   end if;
 851
 852                end;
 853
 854             when N_String_Type_Declaration =>
 855
 856                --  There is nothing to process
 857
 858                null;
 859
 860             when N_Attribute_Declaration      |
 861                  N_Typed_Variable_Declaration |
 862                  N_Variable_Declaration       =>
 863
 864                   pragma Assert (Expression_Of (Current_Item) /= Empty_Node,
 865                                  "no expression for an object declaration");
 866
 867                declare
 868                   New_Value : constant Variable_Value :=
 869                                 Expression
 870                                   (Project           => Project,
 871                                    From_Project_Node => From_Project_Node,
 872                                    Pkg               => Pkg,
 873                                    First_Term        =>
 874                                      Tree.First_Term (Expression_Of
 875                                                               (Current_Item)),
 876                                    Kind              =>
 877                                      Expression_Kind_Of (Current_Item));
 878
 879                   The_Variable : Variable_Id := No_Variable;
 880
 881                   Current_Item_Name : constant Name_Id :=
 882                                         Name_Of (Current_Item);
 883
 884                begin
 885                   if Kind_Of (Current_Item) = N_Typed_Variable_Declaration then
 886
 887                      if String_Equal (New_Value.Value, Empty_String) then
 888                         Error_Msg_Name_1 := Name_Of (Current_Item);
 889
 890                         if Error_Report = null then
 891                            Error_Msg
 892                              ("no value defined for %",
 893                               Location_Of (Current_Item));
 894
 895                         else
 896                            Error_Report
 897                              ("no value defined for " &
 898                               Get_Name_String (Error_Msg_Name_1));
 899                         end if;
 900
 901                      else
 902                         declare
 903                            Current_String : Project_Node_Id :=
 904                                               First_Literal_String
 905                                                 (String_Type_Of
 906                                                   (Current_Item));
 907
 908                         begin
 909                            while Current_String /= Empty_Node
 910                              and then not String_Equal
 911                                             (String_Value_Of (Current_String),
 912                                              New_Value.Value)
 913                            loop
 914                               Current_String :=
 915                                 Next_Literal_String (Current_String);
 916                            end loop;
 917
 918                            if Current_String = Empty_Node then
 919                               String_To_Name_Buffer (New_Value.Value);
 920                               Error_Msg_Name_1 := Name_Find;
 921                               Error_Msg_Name_2 := Name_Of (Current_Item);
 922
 923                               if Error_Report = null then
 924                                  Error_Msg
 925                                    ("value { is illegal for typed string %",
 926                                     Location_Of (Current_Item));
 927
 928                               else
 929                                  Error_Report
 930                                    ("value """ &
 931                                     Get_Name_String (Error_Msg_Name_1) &
 932                                     """ is illegal for typed string """ &
 933                                     Get_Name_String (Error_Msg_Name_2) &
 934                                     """");
 935                               end if;
 936                            end if;
 937                         end;
 938                      end if;
 939                   end if;
 940
 941                   if Kind_Of (Current_Item) /= N_Attribute_Declaration
 942                     or else
 943                       Associative_Array_Index_Of (Current_Item) = No_String
 944                   then
 945                      --  Usual case
 946
 947                      --  Code below really needs more comments ???
 948
 949                      if Kind_Of (Current_Item) = N_Attribute_Declaration then
 950                         if Pkg /= No_Package then
 951                            The_Variable :=
 952                              Packages.Table (Pkg).Decl.Attributes;
 953
 954                         else
 955                            The_Variable :=
 956                              Projects.Table (Project).Decl.Attributes;
 957                         end if;
 958
 959                      else
 960                         if Pkg /= No_Package then
 961                            The_Variable :=
 962                              Packages.Table (Pkg).Decl.Variables;
 963
 964                         else
 965                            The_Variable :=
 966                              Projects.Table (Project).Decl.Variables;
 967                         end if;
 968
 969                      end if;
 970
 971                      while
 972                        The_Variable /= No_Variable
 973                          and then
 974                            Variable_Elements.Table (The_Variable).Name /=
 975                                                           Current_Item_Name
 976                      loop
 977                         The_Variable :=
 978                           Variable_Elements.Table (The_Variable).Next;
 979                      end loop;
 980
 981                      if The_Variable = No_Variable then
 982                         pragma Assert
 983                           (Kind_Of (Current_Item) /= N_Attribute_Declaration,
 984                            "illegal attribute declaration");
 985
 986                         Variable_Elements.Increment_Last;
 987                         The_Variable := Variable_Elements.Last;
 988
 989                         if Pkg /= No_Package then
 990                            Variable_Elements.Table (The_Variable) :=
 991                              (Next    =>
 992                                 Packages.Table (Pkg).Decl.Variables,
 993                               Name    => Current_Item_Name,
 994                               Value   => New_Value);
 995                            Packages.Table (Pkg).Decl.Variables := The_Variable;
 996
 997                         else
 998                            Variable_Elements.Table (The_Variable) :=
 999                              (Next    =>
1000                                 Projects.Table (Project).Decl.Variables,
1001                               Name    => Current_Item_Name,
1002                               Value   => New_Value);
1003                            Projects.Table (Project).Decl.Variables :=
1004                              The_Variable;
1005                         end if;
1006
1007                      else
1008                         Variable_Elements.Table (The_Variable).Value :=
1009                           New_Value;
1010
1011                      end if;
1012
1013                   else
1014                      --  Associative array attribute
1015
1016                      String_To_Name_Buffer
1017                        (Associative_Array_Index_Of (Current_Item));
1018
1019                      if Case_Insensitive (Current_Item) then
1020                         GNAT.Case_Util.To_Lower (Name_Buffer (1 .. Name_Len));
1021                      end if;
1022
1023                      declare
1024                         The_Array : Array_Id;
1025
1026                         The_Array_Element : Array_Element_Id :=
1027                                               No_Array_Element;
1028
1029                         Index_Name : constant Name_Id := Name_Find;
1030
1031                      begin
1032
1033                         if Pkg /= No_Package then
1034                            The_Array := Packages.Table (Pkg).Decl.Arrays;
1035
1036                         else
1037                            The_Array := Projects.Table (Project).Decl.Arrays;
1038                         end if;
1039
1040                         while
1041                           The_Array /= No_Array
1042                             and then Arrays.Table (The_Array).Name /=
1043                                                            Current_Item_Name
1044                         loop
1045                            The_Array := Arrays.Table (The_Array).Next;
1046                         end loop;
1047
1048                         if The_Array = No_Array then
1049                            Arrays.Increment_Last;
1050                            The_Array := Arrays.Last;
1051
1052                            if Pkg /= No_Package then
1053                               Arrays.Table (The_Array) :=
1054                                 (Name  => Current_Item_Name,
1055                                  Value => No_Array_Element,
1056                                  Next  => Packages.Table (Pkg).Decl.Arrays);
1057                               Packages.Table (Pkg).Decl.Arrays := The_Array;
1058
1059                            else
1060                               Arrays.Table (The_Array) :=
1061                                 (Name  => Current_Item_Name,
1062                                  Value => No_Array_Element,
1063                                  Next  =>
1064                                    Projects.Table (Project).Decl.Arrays);
1065                               Projects.Table (Project).Decl.Arrays :=
1066                                 The_Array;
1067                            end if;
1068
1069                         else
1070                            The_Array_Element := Arrays.Table (The_Array).Value;
1071                         end if;
1072
1073                         while The_Array_Element /= No_Array_Element
1074                           and then
1075                             Array_Elements.Table (The_Array_Element).Index /=
1076                                                                   Index_Name
1077                         loop
1078                            The_Array_Element :=
1079                              Array_Elements.Table (The_Array_Element).Next;
1080                         end loop;
1081
1082                         if The_Array_Element = No_Array_Element then
1083                            Array_Elements.Increment_Last;
1084                            The_Array_Element := Array_Elements.Last;
1085                            Array_Elements.Table (The_Array_Element) :=
1086                              (Index  => Index_Name,
1087                               Value  => New_Value,
1088                               Next   => Arrays.Table (The_Array).Value);
1089                            Arrays.Table (The_Array).Value := The_Array_Element;
1090
1091                         else
1092                            Array_Elements.Table (The_Array_Element).Value :=
1093                              New_Value;
1094                         end if;
1095                      end;
1096                   end if;
1097                end;
1098
1099             when N_Case_Construction =>
1100                declare
1101                   The_Project   : Project_Id      := Project;
1102                   The_Package   : Package_Id      := Pkg;
1103                   The_Variable  : Variable_Value  := Nil_Variable_Value;
1104                   Case_Value    : String_Id       := No_String;
1105                   Case_Item     : Project_Node_Id := Empty_Node;
1106                   Choice_String : Project_Node_Id := Empty_Node;
1107                   Decl_Item     : Project_Node_Id := Empty_Node;
1108
1109                begin
1110                   declare
1111                      Variable_Node : constant Project_Node_Id :=
1112                                        Case_Variable_Reference_Of
1113                                          (Current_Item);
1114
1115                      Var_Id : Variable_Id := No_Variable;
1116                      Name   : Name_Id     := No_Name;
1117
1118                   begin
1119                      if Project_Node_Of (Variable_Node) /= Empty_Node then
1120                         Name := Name_Of (Project_Node_Of (Variable_Node));
1121                         The_Project :=
1122                           Imported_Or_Modified_Project_From (Project, Name);
1123                      end if;
1124
1125                      if Package_Node_Of (Variable_Node) /= Empty_Node then
1126                         Name := Name_Of (Package_Node_Of (Variable_Node));
1127                         The_Package := Package_From (The_Project, Name);
1128                      end if;
1129
1130                      Name := Name_Of (Variable_Node);
1131
1132                      if The_Package /= No_Package then
1133                         Var_Id := Packages.Table (The_Package).Decl.Variables;
1134                         Name := Name_Of (Variable_Node);
1135                         while Var_Id /= No_Variable
1136                           and then
1137                             Variable_Elements.Table (Var_Id).Name /= Name
1138                         loop
1139                            Var_Id := Variable_Elements.Table (Var_Id).Next;
1140                         end loop;
1141                      end if;
1142
1143                      if Var_Id = No_Variable
1144                        and then Package_Node_Of (Variable_Node) = Empty_Node
1145                      then
1146                         Var_Id := Projects.Table (The_Project).Decl.Variables;
1147                         while Var_Id /= No_Variable
1148                           and then
1149                             Variable_Elements.Table (Var_Id).Name /= Name
1150                         loop
1151                            Var_Id := Variable_Elements.Table (Var_Id).Next;
1152                         end loop;
1153                      end if;
1154
1155                      if Var_Id = No_Variable then
1156
1157                         --  Should never happen
1158
1159                         Write_Line ("variable """ &
1160                                     Get_Name_String (Name) &
1161                                     """ not found");
1162                         raise Program_Error;
1163                      end if;
1164
1165                      The_Variable := Variable_Elements.Table (Var_Id).Value;
1166
1167                      if The_Variable.Kind /= Single then
1168
1169                         --  Should never happen
1170
1171                         Write_Line ("variable""" &
1172                                     Get_Name_String (Name) &
1173                                     """ is not a single string variable");
1174                         raise Program_Error;
1175                      end if;
1176
1177                      Case_Value := The_Variable.Value;
1178                   end;
1179
1180                   Case_Item := First_Case_Item_Of (Current_Item);
1181                   Case_Item_Loop :
1182                      while Case_Item /= Empty_Node loop
1183                         Choice_String := First_Choice_Of (Case_Item);
1184
1185                         if Choice_String = Empty_Node then
1186                            Decl_Item := First_Declarative_Item_Of (Case_Item);
1187                            exit Case_Item_Loop;
1188                         end if;
1189
1190                         Choice_Loop :
1191                            while Choice_String /= Empty_Node loop
1192                               if String_Equal (Case_Value,
1193                                                String_Value_Of (Choice_String))
1194                               then
1195                                  Decl_Item :=
1196                                    First_Declarative_Item_Of (Case_Item);
1197                                  exit Case_Item_Loop;
1198                               end if;
1199
1200                               Choice_String :=
1201                                 Next_Literal_String (Choice_String);
1202                            end loop Choice_Loop;
1203                         Case_Item := Next_Case_Item (Case_Item);
1204                      end loop Case_Item_Loop;
1205
1206                   if Decl_Item /= Empty_Node then
1207                      Process_Declarative_Items
1208                        (Project           => Project,
1209                         From_Project_Node => From_Project_Node,
1210                         Pkg               => Pkg,
1211                         Item              => Decl_Item);
1212                   end if;
1213                end;
1214
1215             when others =>
1216
1217                --  Should never happen
1218
1219                Write_Line ("Illegal declarative item: " &
1220                            Project_Node_Kind'Image (Kind_Of (Current_Item)));
1221                raise Program_Error;
1222          end case;
1223       end loop;
1224    end Process_Declarative_Items;
1225
1226    ---------------------
1227    -- Recursive_Check --
1228    ---------------------
1229
1230    procedure Recursive_Check (Project : Project_Id) is
1231       Data                  : Project_Data;
1232       Imported_Project_List : Project_List := Empty_Project_List;
1233
1234    begin
1235       --  Do nothing if Project is No_Project, or Project has already
1236       --  been marked as checked.
1237
1238       if Project /= No_Project
1239         and then not Projects.Table (Project).Checked
1240       then
1241          Data := Projects.Table (Project);
1242
1243          --  Call itself for a possible modified project.
1244          --  (if there is no modified project, then nothing happens).
1245
1246          Recursive_Check (Data.Modifies);
1247
1248          --  Call itself for all imported projects
1249
1250          Imported_Project_List := Data.Imported_Projects;
1251          while Imported_Project_List /= Empty_Project_List loop
1252             Recursive_Check
1253               (Project_Lists.Table (Imported_Project_List).Project);
1254             Imported_Project_List :=
1255               Project_Lists.Table (Imported_Project_List).Next;
1256          end loop;
1257
1258          --  Mark project as checked
1259
1260          Projects.Table (Project).Checked := True;
1261
1262          if Opt.Verbose_Mode then
1263             Write_Str ("Checking project file """);
1264             Write_Str (Get_Name_String (Data.Name));
1265             Write_Line ("""");
1266          end if;
1267
1268          Prj.Nmsc.Ada_Check (Project, Error_Report);
1269       end if;
1270    end Recursive_Check;
1271
1272    -----------------------
1273    -- Recursive_Process --
1274    -----------------------
1275
1276    procedure Recursive_Process
1277      (Project           : out Project_Id;
1278       From_Project_Node : Project_Node_Id;
1279       Modified_By       : Project_Id)
1280    is
1281       With_Clause : Project_Node_Id;
1282
1283    begin
1284       if From_Project_Node = Empty_Node then
1285          Project := No_Project;
1286
1287       else
1288          declare
1289             Processed_Data   : Project_Data := Empty_Project;
1290             Imported         : Project_List := Empty_Project_List;
1291             Declaration_Node : Project_Node_Id := Empty_Node;
1292             Name             : constant Name_Id :=
1293                                  Name_Of (From_Project_Node);
1294
1295          begin
1296             Project := Processed_Projects.Get (Name);
1297
1298             if Project /= No_Project then
1299                return;
1300             end if;
1301
1302             Projects.Increment_Last;
1303             Project := Projects.Last;
1304             Processed_Projects.Set (Name, Project);
1305             Processed_Data.Name        := Name;
1306             Processed_Data.Path_Name   := Path_Name_Of (From_Project_Node);
1307             Processed_Data.Location    := Location_Of (From_Project_Node);
1308             Processed_Data.Directory   := Directory_Of (From_Project_Node);
1309             Processed_Data.Modified_By := Modified_By;
1310             Add_Attributes (Processed_Data.Decl, Attribute_First);
1311             With_Clause := First_With_Clause_Of (From_Project_Node);
1312
1313             while With_Clause /= Empty_Node loop
1314                declare
1315                   New_Project : Project_Id;
1316                   New_Data    : Project_Data;
1317
1318                begin
1319                   Recursive_Process
1320                     (Project           => New_Project,
1321                      From_Project_Node => Project_Node_Of (With_Clause),
1322                      Modified_By       => No_Project);
1323                   New_Data := Projects.Table (New_Project);
1324
1325                   --  If we were the first project to import it,
1326                   --  set First_Referred_By to us.
1327
1328                   if New_Data.First_Referred_By = No_Project then
1329                      New_Data.First_Referred_By := Project;
1330                      Projects.Table (New_Project) := New_Data;
1331                   end if;
1332
1333                   --  Add this project to our list of imported projects
1334
1335                   Project_Lists.Increment_Last;
1336                   Project_Lists.Table (Project_Lists.Last) :=
1337                     (Project => New_Project, Next => Empty_Project_List);
1338
1339                   --  Imported is the id of the last imported project.
1340                   --  If it is nil, then this imported project is our first.
1341
1342                   if Imported = Empty_Project_List then
1343                      Processed_Data.Imported_Projects := Project_Lists.Last;
1344
1345                   else
1346                      Project_Lists.Table (Imported).Next := Project_Lists.Last;
1347                   end if;
1348
1349                   Imported := Project_Lists.Last;
1350
1351                   With_Clause := Next_With_Clause_Of (With_Clause);
1352                end;
1353             end loop;
1354
1355             Declaration_Node := Project_Declaration_Of (From_Project_Node);
1356
1357             Recursive_Process
1358               (Project           => Processed_Data.Modifies,
1359                From_Project_Node => Modified_Project_Of (Declaration_Node),
1360                Modified_By       => Project);
1361
1362             Projects.Table (Project) := Processed_Data;
1363
1364             Process_Declarative_Items
1365               (Project           => Project,
1366                From_Project_Node => From_Project_Node,
1367                Pkg               => No_Package,
1368                Item              => First_Declarative_Item_Of
1369                                       (Declaration_Node));
1370
1371          end;
1372       end if;
1373    end Recursive_Process;
1374
1375 end Prj.Proc;