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