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