gcc/ada/prj-proc.adb

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