gcc/ada/gnatcmd.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              G N A T C M D                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1996-2005, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
  28
  29 with Csets;
  30 with MLib.Tgt; use MLib.Tgt;
  31 with MLib.Utl;
  32 with Namet;    use Namet;
  33 with Opt;      use Opt;
  34 with Osint;    use Osint;
  35 with Output;
  36 with Prj;      use Prj;
  37 with Prj.Env;
  38 with Prj.Ext;  use Prj.Ext;
  39 with Prj.Pars;
  40 with Prj.Util; use Prj.Util;
  41 with Sinput.P;
  42 with Snames;   use Snames;
  43 with Table;
  44 with Types;    use Types;
  45 with Hostparm; use Hostparm;
  46 --  Used to determine if we are in VMS or not for error message purposes
  47
  48 with Ada.Characters.Handling; use Ada.Characters.Handling;
  49 with Ada.Command_Line;        use Ada.Command_Line;
  50 with Ada.Text_IO;             use Ada.Text_IO;
  51
  52 with GNAT.OS_Lib;             use GNAT.OS_Lib;
  53
  54 with Table;
  55
  56 with VMS_Conv; use VMS_Conv;
  57
  58 procedure GNATCmd is
  59    Project_Tree      : constant Project_Tree_Ref := new Project_Tree_Data;
  60    Project_File      : String_Access;
  61    Project           : Prj.Project_Id;
  62    Current_Verbosity : Prj.Verbosity := Prj.Default;
  63    Tool_Package_Name : Name_Id       := No_Name;
  64
  65    Old_Project_File_Used : Boolean := False;
  66    --  This flag indicates a switch -p (for gnatxref and gnatfind) for
  67    --  an old fashioned project file. -p cannot be used in conjonction
  68    --  with -P.
  69
  70    Max_Files_On_The_Command_Line : constant := 30; --  Arbitrary
  71
  72    Temp_File_Name : String_Access := null;
  73    --  The name of the temporary text file to put a list of source/object
  74    --  files to pass to a tool, when there are more than
  75    --  Max_Files_On_The_Command_Line files.
  76
  77    package First_Switches is new Table.Table
  78      (Table_Component_Type => String_Access,
  79       Table_Index_Type     => Integer,
  80       Table_Low_Bound      => 1,
  81       Table_Initial        => 20,
  82       Table_Increment      => 100,
  83       Table_Name           => "Gnatcmd.First_Switches");
  84    --  A table to keep the switches from the project file
  85
  86    package Carg_Switches is new Table.Table
  87      (Table_Component_Type => String_Access,
  88       Table_Index_Type     => Integer,
  89       Table_Low_Bound      => 1,
  90       Table_Initial        => 20,
  91       Table_Increment      => 100,
  92       Table_Name           => "Gnatcmd.Carg_Switches");
  93    --  A table to keep the switches following -cargs for ASIS tools
  94
  95    package Library_Paths is new Table.Table (
  96      Table_Component_Type => String_Access,
  97      Table_Index_Type     => Integer,
  98      Table_Low_Bound      => 1,
  99      Table_Initial        => 20,
 100      Table_Increment      => 100,
 101      Table_Name           => "Make.Library_Path");
 102
 103    --  Packages of project files to pass to Prj.Pars.Parse, depending on the
 104    --  tool. We allocate objects because we cannot declare aliased objects
 105    --  as we are in a procedure, not a library level package.
 106
 107    Naming_String    : constant String_Access := new String'("naming");
 108    Binder_String    : constant String_Access := new String'("binder");
 109    Compiler_String  : constant String_Access := new String'("compiler");
 110    Check_String     : constant String_Access := new String'("check");
 111    Eliminate_String : constant String_Access := new String'("eliminate");
 112    Finder_String    : constant String_Access := new String'("finder");
 113    Linker_String    : constant String_Access := new String'("linker");
 114    Gnatls_String    : constant String_Access := new String'("gnatls");
 115    Pretty_String    : constant String_Access := new String'("pretty_printer");
 116    Gnatstub_String  : constant String_Access := new String'("gnatstub");
 117    Metric_String    : constant String_Access := new String'("metrics");
 118    Xref_String      : constant String_Access := new String'("cross_reference");
 119
 120    Packages_To_Check_By_Binder   : constant String_List_Access :=
 121      new String_List'((Naming_String, Binder_String));
 122
 123    Packages_To_Check_By_Check : constant String_List_Access :=
 124      new String_List'((Naming_String, Check_String, Compiler_String));
 125
 126    Packages_To_Check_By_Eliminate : constant String_List_Access :=
 127      new String_List'((Naming_String, Eliminate_String, Compiler_String));
 128
 129    Packages_To_Check_By_Finder    : constant String_List_Access :=
 130      new String_List'((Naming_String, Finder_String));
 131
 132    Packages_To_Check_By_Linker    : constant String_List_Access :=
 133      new String_List'((Naming_String, Linker_String));
 134
 135    Packages_To_Check_By_Gnatls    : constant String_List_Access :=
 136      new String_List'((Naming_String, Gnatls_String));
 137
 138    Packages_To_Check_By_Pretty    : constant String_List_Access :=
 139      new String_List'((Naming_String, Pretty_String, Compiler_String));
 140
 141    Packages_To_Check_By_Gnatstub  : constant String_List_Access :=
 142      new String_List'((Naming_String, Gnatstub_String, Compiler_String));
 143
 144    Packages_To_Check_By_Metric  : constant String_List_Access :=
 145      new String_List'((Naming_String, Metric_String, Compiler_String));
 146
 147    Packages_To_Check_By_Xref      : constant String_List_Access :=
 148      new String_List'((Naming_String, Xref_String));
 149
 150    Packages_To_Check : String_List_Access := Prj.All_Packages;
 151
 152    ----------------------------------
 153    -- Declarations for GNATCMD use --
 154    ----------------------------------
 155
 156    The_Command : Command_Type;
 157    --  The command specified in the invocation of the GNAT driver
 158
 159    Command_Arg : Positive := 1;
 160    --  The index of the command in the arguments of the GNAT driver
 161
 162    My_Exit_Status : Exit_Status := Success;
 163    --  The exit status of the spawned tool. Used to set the correct VMS
 164    --  exit status.
 165
 166    Current_Work_Dir : constant String := Get_Current_Dir;
 167    --  The path of the working directory
 168
 169    All_Projects : Boolean := False;
 170    --  Flag used for GNAT PRETTY and GNAT METRIC to indicate that
 171    --  the underlying tool (gnatcheck, gnatpp or gnatmetric) should be invoked
 172    --  for all sources of all projects.
 173
 174    -----------------------
 175    -- Local Subprograms --
 176    -----------------------
 177
 178    procedure Add_To_Carg_Switches (Switch : String_Access);
 179    --  Add a switch to the Carg_Switches table. If it is the first one,
 180    --  put the switch "-cargs" at the beginning of the table.
 181
 182    procedure Check_Files;
 183    --  For GNAT LIST, GNAT PRETTY and GNAT METRIC, check if a project
 184    --  file is specified, without any file arguments. If it is the case,
 185    --  invoke the GNAT tool with the proper list of files, derived from
 186    --  the sources of the project.
 187
 188    function Check_Project
 189      (Project      : Project_Id;
 190       Root_Project : Project_Id) return Boolean;
 191    --  Returns True if Project = Root_Project.
 192    --  For GNAT METRIC, also returns True if Project is extended by
 193    --  Root_Project.
 194
 195    procedure Check_Relative_Executable (Name : in out String_Access);
 196    --  Check if an executable is specified as a relative path.
 197    --  If it is, and the path contains directory information, fail.
 198    --  Otherwise, prepend the exec directory.
 199    --  This procedure is only used for GNAT LINK when a project file
 200    --  is specified.
 201
 202    function Configuration_Pragmas_File return Name_Id;
 203    --  Return an argument, if there is a configuration pragmas file to be
 204    --  specified for Project, otherwise return No_Name.
 205    --  Used for gnatstub (GNAT STUB), gnatpp (GNAT PRETTY), gnatelim
 206    --  (GNAT ELIM), and gnatmetric (GNAT METRIC).
 207
 208    procedure Delete_Temp_Config_Files;
 209    --  Delete all temporary config files
 210
 211    function Index (Char : Character; Str : String) return Natural;
 212    --  Returns the first occurrence of Char in Str.
 213    --  Returns 0 if Char is not in Str.
 214
 215    procedure Non_VMS_Usage;
 216    --  Display usage for platforms other than VMS
 217
 218    procedure Process_Link;
 219    --  Process GNAT LINK, when there is a project file specified
 220
 221    procedure Set_Library_For
 222      (Project             : Project_Id;
 223       There_Are_Libraries : in out Boolean);
 224    --  If Project is a library project, add the correct
 225    --  -L and -l switches to the linker invocation.
 226
 227    procedure Set_Libraries is
 228       new For_Every_Project_Imported (Boolean, Set_Library_For);
 229    --  Add the -L and -l switches to the linker for all
 230    --  of the library projects.
 231
 232    procedure Test_If_Relative_Path
 233      (Switch : in out String_Access;
 234       Parent : String);
 235    --  Test if Switch is a relative search path switch.
 236    --  If it is and it includes directory information, prepend the path with
 237    --  Parent.This subprogram is only called when using project files.
 238
 239    --------------------------
 240    -- Add_To_Carg_Switches --
 241    --------------------------
 242
 243    procedure Add_To_Carg_Switches (Switch : String_Access) is
 244    begin
 245       --  If the Carg_Switches table is empty, put "-cargs" at the beginning
 246
 247       if Carg_Switches.Last = 0 then
 248          Carg_Switches.Increment_Last;
 249          Carg_Switches.Table (Carg_Switches.Last) := new String'("-cargs");
 250       end if;
 251
 252       Carg_Switches.Increment_Last;
 253       Carg_Switches.Table (Carg_Switches.Last) := Switch;
 254    end Add_To_Carg_Switches;
 255
 256    -----------------
 257    -- Check_Files --
 258    -----------------
 259
 260    procedure Check_Files is
 261       Add_Sources : Boolean := True;
 262       Unit_Data   : Prj.Unit_Data;
 263       Subunit     : Boolean := False;
 264
 265    begin
 266       --  Check if there is at least one argument that is not a switch
 267
 268       for Index in 1 .. Last_Switches.Last loop
 269          if Last_Switches.Table (Index) (1) /= '-' then
 270             Add_Sources := False;
 271             exit;
 272          end if;
 273       end loop;
 274
 275       --  If all arguments were switches, add the path names of
 276       --  all the sources of the main project.
 277
 278       if Add_Sources then
 279          declare
 280             Current_Last : constant Integer := Last_Switches.Last;
 281          begin
 282             for Unit in Unit_Table.First ..
 283                         Unit_Table.Last (Project_Tree.Units)
 284             loop
 285                Unit_Data := Project_Tree.Units.Table (Unit);
 286
 287                --  For gnatls, we only need to put the library units,
 288                --  body or spec, but not the subunits.
 289
 290                if The_Command = List then
 291                   if
 292                     Unit_Data.File_Names (Body_Part).Name /= No_Name
 293                   then
 294                      --  There is a body; check if it is for this
 295                      --  project.
 296
 297                      if Unit_Data.File_Names (Body_Part).Project =
 298                        Project
 299                      then
 300                         Subunit := False;
 301
 302                         if Unit_Data.File_Names (Specification).Name =
 303                           No_Name
 304                         then
 305                            --  We have a body with no spec: we need
 306                            --  to check if this is a subunit, because
 307                            --  gnatls will complain about subunits.
 308
 309                            declare
 310                               Src_Ind : Source_File_Index;
 311
 312                            begin
 313                               Src_Ind := Sinput.P.Load_Project_File
 314                                 (Get_Name_String
 315                                    (Unit_Data.File_Names
 316                                       (Body_Part).Path));
 317
 318                               Subunit :=
 319                                 Sinput.P.Source_File_Is_Subunit
 320                                   (Src_Ind);
 321                            end;
 322                         end if;
 323
 324                         if not Subunit then
 325                            Last_Switches.Increment_Last;
 326                            Last_Switches.Table (Last_Switches.Last) :=
 327                              new String'
 328                                (Get_Name_String
 329                                     (Unit_Data.File_Names
 330                                          (Body_Part).Display_Name));
 331                         end if;
 332                      end if;
 333
 334                   elsif Unit_Data.File_Names (Specification).Name /=
 335                     No_Name
 336                   then
 337                      --  We have a spec with no body; check if it is
 338                      --  for this project.
 339
 340                      if Unit_Data.File_Names (Specification).Project =
 341                        Project
 342                      then
 343                         Last_Switches.Increment_Last;
 344                         Last_Switches.Table (Last_Switches.Last) :=
 345                           new String'
 346                             (Get_Name_String
 347                                  (Unit_Data.File_Names
 348                                       (Specification).Display_Name));
 349                      end if;
 350                   end if;
 351
 352                else
 353                   --  For gnatcheck, gnatpp and gnatmetric, put all sources
 354                   --  of the project, or of all projects if -U was specified.
 355
 356                   for Kind in Spec_Or_Body loop
 357
 358                      --  Put only sources that belong to the main
 359                      --  project.
 360
 361                      if Check_Project
 362                           (Unit_Data.File_Names (Kind).Project, Project)
 363                      then
 364                         Last_Switches.Increment_Last;
 365                         Last_Switches.Table (Last_Switches.Last) :=
 366                           new String'
 367                             (Get_Name_String
 368                                  (Unit_Data.File_Names
 369                                       (Kind).Display_Path));
 370                      end if;
 371                   end loop;
 372                end if;
 373             end loop;
 374
 375             --  If the list of files is too long, create a temporary
 376             --  text file that lists these files, and pass this temp
 377             --  file to gnatcheck, gnatpp or gnatmetric using switch -files=.
 378
 379             if Last_Switches.Last - Current_Last >
 380               Max_Files_On_The_Command_Line
 381             then
 382                declare
 383                   Temp_File_FD : File_Descriptor;
 384                   Buffer       : String (1 .. 1_000);
 385                   Len          : Natural;
 386                   OK           : Boolean := True;
 387
 388                begin
 389                   Create_Temp_File (Temp_File_FD, Temp_File_Name);
 390
 391                   if Temp_File_Name /= null then
 392                      for Index in Current_Last + 1 ..
 393                        Last_Switches.Last
 394                      loop
 395                         Len := Last_Switches.Table (Index)'Length;
 396                         Buffer (1 .. Len) :=
 397                           Last_Switches.Table (Index).all;
 398                         Len := Len + 1;
 399                         Buffer (Len) := ASCII.LF;
 400                         Buffer (Len + 1) := ASCII.NUL;
 401                         OK :=
 402                           Write (Temp_File_FD,
 403                                  Buffer (1)'Address,
 404                                  Len) = Len;
 405                         exit when not OK;
 406                      end loop;
 407
 408                      if OK then
 409                         Close (Temp_File_FD, OK);
 410                      else
 411                         Close (Temp_File_FD, OK);
 412                         OK := False;
 413                      end if;
 414
 415                      --  If there were any problem creating the temp
 416                      --  file, then pass the list of files.
 417
 418                      if OK then
 419
 420                         --  Replace the list of files with
 421                         --  "-files=<temp file name>".
 422
 423                         Last_Switches.Set_Last (Current_Last + 1);
 424                         Last_Switches.Table (Last_Switches.Last) :=
 425                           new String'("-files=" & Temp_File_Name.all);
 426                      end if;
 427                   end if;
 428                end;
 429             end if;
 430          end;
 431       end if;
 432    end Check_Files;
 433
 434    -------------------
 435    -- Check_Project --
 436    -------------------
 437
 438    function Check_Project
 439      (Project      : Project_Id;
 440       Root_Project : Project_Id) return Boolean
 441    is
 442    begin
 443       if Project = No_Project then
 444          return False;
 445
 446       elsif All_Projects or Project = Root_Project then
 447          return True;
 448
 449       elsif The_Command = Metric then
 450          declare
 451             Data : Project_Data :=
 452                      Project_Tree.Projects.Table (Root_Project);
 453
 454          begin
 455             while Data.Extends /= No_Project loop
 456                if Project = Data.Extends then
 457                   return True;
 458                end if;
 459
 460                Data := Project_Tree.Projects.Table (Data.Extends);
 461             end loop;
 462          end;
 463       end if;
 464
 465       return False;
 466    end Check_Project;
 467
 468    -------------------------------
 469    -- Check_Relative_Executable --
 470    -------------------------------
 471
 472    procedure Check_Relative_Executable (Name : in out String_Access) is
 473       Exec_File_Name : constant String := Name.all;
 474
 475    begin
 476       if not Is_Absolute_Path (Exec_File_Name) then
 477          for Index in Exec_File_Name'Range loop
 478             if Exec_File_Name (Index) = Directory_Separator then
 479                Fail ("relative executable (""" &
 480                        Exec_File_Name &
 481                        """) with directory part not allowed " &
 482                        "when using project files");
 483             end if;
 484          end loop;
 485
 486          Get_Name_String (Project_Tree.Projects.Table
 487                             (Project).Exec_Directory);
 488
 489          if Name_Buffer (Name_Len) /= Directory_Separator then
 490             Name_Len := Name_Len + 1;
 491             Name_Buffer (Name_Len) := Directory_Separator;
 492          end if;
 493
 494          Name_Buffer (Name_Len + 1 ..
 495                         Name_Len + Exec_File_Name'Length) :=
 496            Exec_File_Name;
 497          Name_Len := Name_Len + Exec_File_Name'Length;
 498          Name := new String'(Name_Buffer (1 .. Name_Len));
 499       end if;
 500    end Check_Relative_Executable;
 501
 502    --------------------------------
 503    -- Configuration_Pragmas_File --
 504    --------------------------------
 505
 506    function Configuration_Pragmas_File return Name_Id is
 507    begin
 508       Prj.Env.Create_Config_Pragmas_File
 509         (Project, Project, Project_Tree, Include_Config_Files => False);
 510       return Project_Tree.Projects.Table (Project).Config_File_Name;
 511    end Configuration_Pragmas_File;
 512
 513    ------------------------------
 514    -- Delete_Temp_Config_Files --
 515    ------------------------------
 516
 517    procedure Delete_Temp_Config_Files is
 518       Success : Boolean;
 519
 520    begin
 521       if not Keep_Temporary_Files then
 522          if Project /= No_Project then
 523             for Prj in Project_Table.First ..
 524                        Project_Table.Last (Project_Tree.Projects)
 525             loop
 526                if
 527                  Project_Tree.Projects.Table (Prj).Config_File_Temp
 528                then
 529                   if Verbose_Mode then
 530                      Output.Write_Str ("Deleting temp configuration file """);
 531                      Output.Write_Str
 532                        (Get_Name_String
 533                           (Project_Tree.Projects.Table
 534                              (Prj).Config_File_Name));
 535                      Output.Write_Line ("""");
 536                   end if;
 537
 538                   Delete_File
 539                     (Name    => Get_Name_String
 540                        (Project_Tree.Projects.Table
 541                           (Prj).Config_File_Name),
 542                      Success => Success);
 543                end if;
 544             end loop;
 545          end if;
 546
 547          --  If a temporary text file that contains a list of files for a tool
 548          --  has been created, delete this temporary file.
 549
 550          if Temp_File_Name /= null then
 551             Delete_File (Temp_File_Name.all, Success);
 552          end if;
 553       end if;
 554    end Delete_Temp_Config_Files;
 555
 556    -----------
 557    -- Index --
 558    -----------
 559
 560    function Index (Char : Character; Str : String) return Natural is
 561    begin
 562       for Index in Str'Range loop
 563          if Str (Index) = Char then
 564             return Index;
 565          end if;
 566       end loop;
 567
 568       return 0;
 569    end Index;
 570
 571    ------------------
 572    -- Process_Link --
 573    ------------------
 574
 575    procedure Process_Link is
 576       Look_For_Executable  : Boolean := True;
 577       There_Are_Libraries  : Boolean := False;
 578       Path_Option          : constant String_Access :=
 579                                MLib.Linker_Library_Path_Option;
 580       Prj                  : Project_Id := Project;
 581       Arg                  : String_Access;
 582       Last                 : Natural := 0;
 583       Skip_Executable      : Boolean := False;
 584
 585    begin
 586       --  Add the default search directories, to be able to find
 587       --  libgnat in call to MLib.Utl.Lib_Directory.
 588
 589       Add_Default_Search_Dirs;
 590
 591       Library_Paths.Set_Last (0);
 592
 593       --  Check if there are library project files
 594
 595       if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then
 596          Set_Libraries (Project, Project_Tree, There_Are_Libraries);
 597       end if;
 598
 599       --  If there are, add the necessary additional switches
 600
 601       if There_Are_Libraries then
 602
 603          --  Add -L<lib_dir> -lgnarl -lgnat -Wl,-rpath,<lib_dir>
 604
 605          Last_Switches.Increment_Last;
 606          Last_Switches.Table (Last_Switches.Last) :=
 607            new String'("-L" & MLib.Utl.Lib_Directory);
 608          Last_Switches.Increment_Last;
 609          Last_Switches.Table (Last_Switches.Last) :=
 610            new String'("-lgnarl");
 611          Last_Switches.Increment_Last;
 612          Last_Switches.Table (Last_Switches.Last) :=
 613            new String'("-lgnat");
 614
 615          --  If Path_Option is not null, create the switch
 616          --  ("-Wl,-rpath," or equivalent) with all the library dirs
 617          --  plus the standard GNAT library dir.
 618
 619          if Path_Option /= null then
 620             declare
 621                Option  : String_Access;
 622                Length  : Natural := Path_Option'Length;
 623                Current : Natural;
 624
 625             begin
 626                --  First, compute the exact length for the switch
 627
 628                for Index in
 629                  Library_Paths.First .. Library_Paths.Last
 630                loop
 631                   --  Add the length of the library dir plus one
 632                   --  for the directory separator.
 633
 634                   Length :=
 635                     Length +
 636                       Library_Paths.Table (Index)'Length + 1;
 637                end loop;
 638
 639                --  Finally, add the length of the standard GNAT
 640                --  library dir.
 641
 642                Length := Length + MLib.Utl.Lib_Directory'Length;
 643                Option := new String (1 .. Length);
 644                Option (1 .. Path_Option'Length) := Path_Option.all;
 645                Current := Path_Option'Length;
 646
 647                --  Put each library dir followed by a dir separator
 648
 649                for Index in
 650                  Library_Paths.First .. Library_Paths.Last
 651                loop
 652                   Option
 653                     (Current + 1 ..
 654                        Current +
 655                          Library_Paths.Table (Index)'Length) :=
 656                       Library_Paths.Table (Index).all;
 657                   Current :=
 658                     Current +
 659                       Library_Paths.Table (Index)'Length + 1;
 660                   Option (Current) := Path_Separator;
 661                end loop;
 662
 663                --  Finally put the standard GNAT library dir
 664
 665                Option
 666                  (Current + 1 ..
 667                     Current + MLib.Utl.Lib_Directory'Length) :=
 668                    MLib.Utl.Lib_Directory;
 669
 670                --  And add the switch to the last switches
 671
 672                Last_Switches.Increment_Last;
 673                Last_Switches.Table (Last_Switches.Last) :=
 674                  Option;
 675             end;
 676          end if;
 677       end if;
 678
 679       --  Check if the first ALI file specified can be found, either
 680       --  in the object directory of the main project or in an object
 681       --  directory of a project file extended by the main project.
 682       --  If the ALI file can be found, replace its name with its
 683       --  absolute path.
 684
 685       Skip_Executable := False;
 686
 687       Switch_Loop : for J in 1 .. Last_Switches.Last loop
 688
 689          --  If we have an executable just reset the flag
 690
 691          if Skip_Executable then
 692             Skip_Executable := False;
 693
 694          --  If -o, set flag so that next switch is not processed
 695
 696          elsif Last_Switches.Table (J).all = "-o" then
 697             Skip_Executable := True;
 698
 699          --  Normal case
 700
 701          else
 702             declare
 703                Switch         : constant String :=
 704                                   Last_Switches.Table (J).all;
 705
 706                ALI_File       : constant String (1 .. Switch'Length + 4) :=
 707                                   Switch & ".ali";
 708
 709                Test_Existence : Boolean := False;
 710
 711             begin
 712                Last := Switch'Length;
 713
 714                --  Skip real switches
 715
 716                if Switch'Length /= 0
 717                  and then Switch (Switch'First) /= '-'
 718                then
 719                   --  Append ".ali" if file name does not end with it
 720
 721                   if Switch'Length <= 4
 722                     or else Switch (Switch'Last - 3 .. Switch'Last)
 723                     /= ".ali"
 724                   then
 725                      Last := ALI_File'Last;
 726                   end if;
 727
 728                   --  If file name includes directory information,
 729                   --  stop if ALI file exists.
 730
 731                   if Is_Absolute_Path (ALI_File (1 .. Last)) then
 732                      Test_Existence := True;
 733
 734                   else
 735                      for K in Switch'Range loop
 736                         if Switch (K) = '/' or else
 737                           Switch (K) = Directory_Separator
 738                         then
 739                            Test_Existence := True;
 740                            exit;
 741                         end if;
 742                      end loop;
 743                   end if;
 744
 745                   if Test_Existence then
 746                      if Is_Regular_File (ALI_File (1 .. Last)) then
 747                         exit Switch_Loop;
 748                      end if;
 749
 750                   --  Look in object directories if ALI file exists
 751
 752                   else
 753                      Project_Loop : loop
 754                         declare
 755                            Dir : constant String :=
 756                                    Get_Name_String
 757                                      (Project_Tree.Projects.Table
 758                                         (Prj).Object_Directory);
 759                         begin
 760                            if Is_Regular_File
 761                                 (Dir &
 762                                  Directory_Separator &
 763                                  ALI_File (1 .. Last))
 764                            then
 765                               --  We have found the correct project, so we
 766                               --  replace the file with the absolute path.
 767
 768                               Last_Switches.Table (J) :=
 769                                 new String'
 770                                   (Dir & Directory_Separator &
 771                                    ALI_File (1 .. Last));
 772
 773                               --  And we are done
 774
 775                               exit Switch_Loop;
 776                            end if;
 777                         end;
 778
 779                         --  Go to the project being extended,
 780                         --  if any.
 781
 782                         Prj :=
 783                           Project_Tree.Projects.Table (Prj).Extends;
 784                         exit Project_Loop when Prj = No_Project;
 785                      end loop Project_Loop;
 786                   end if;
 787                end if;
 788             end;
 789          end if;
 790       end loop Switch_Loop;
 791
 792       --  If a relative path output file has been specified, we add
 793       --  the exec directory.
 794
 795       for J in reverse 1 .. Last_Switches.Last - 1 loop
 796          if Last_Switches.Table (J).all = "-o" then
 797             Check_Relative_Executable
 798               (Name => Last_Switches.Table (J + 1));
 799             Look_For_Executable := False;
 800             exit;
 801          end if;
 802       end loop;
 803
 804       if Look_For_Executable then
 805          for J in reverse 1 .. First_Switches.Last - 1 loop
 806             if First_Switches.Table (J).all = "-o" then
 807                Look_For_Executable := False;
 808                Check_Relative_Executable
 809                  (Name => First_Switches.Table (J + 1));
 810                exit;
 811             end if;
 812          end loop;
 813       end if;
 814
 815       --  If no executable is specified, then find the name
 816       --  of the first ALI file on the command line and issue
 817       --  a -o switch with the absolute path of the executable
 818       --  in the exec directory.
 819
 820       if Look_For_Executable then
 821          for J in 1 .. Last_Switches.Last loop
 822             Arg  := Last_Switches.Table (J);
 823             Last := 0;
 824
 825             if Arg'Length /= 0 and then Arg (Arg'First) /= '-' then
 826                if Arg'Length > 4
 827                  and then Arg (Arg'Last - 3 .. Arg'Last) = ".ali"
 828                then
 829                   Last := Arg'Last - 4;
 830
 831                elsif Is_Regular_File (Arg.all & ".ali") then
 832                   Last := Arg'Last;
 833                end if;
 834
 835                if Last /= 0 then
 836                   Last_Switches.Increment_Last;
 837                   Last_Switches.Table (Last_Switches.Last) :=
 838                     new String'("-o");
 839                   Get_Name_String
 840                     (Project_Tree.Projects.Table
 841                        (Project).Exec_Directory);
 842                   Last_Switches.Increment_Last;
 843                   Last_Switches.Table (Last_Switches.Last) :=
 844                     new String'(Name_Buffer (1 .. Name_Len) &
 845                                 Directory_Separator &
 846                                 Base_Name (Arg (Arg'First .. Last)) &
 847                                 Get_Executable_Suffix.all);
 848                   exit;
 849                end if;
 850             end if;
 851          end loop;
 852       end if;
 853    end Process_Link;
 854
 855    ---------------------
 856    -- Set_Library_For --
 857    ---------------------
 858
 859    procedure Set_Library_For
 860      (Project             : Project_Id;
 861       There_Are_Libraries : in out Boolean)
 862    is
 863       Path_Option : constant String_Access :=
 864                       MLib.Linker_Library_Path_Option;
 865
 866    begin
 867       --  Case of library project
 868
 869       if Project_Tree.Projects.Table (Project).Library then
 870          There_Are_Libraries := True;
 871
 872          --  Add the -L switch
 873
 874          Last_Switches.Increment_Last;
 875          Last_Switches.Table (Last_Switches.Last) :=
 876            new String'("-L" &
 877                        Get_Name_String
 878                          (Project_Tree.Projects.Table
 879                             (Project).Library_Dir));
 880
 881          --  Add the -l switch
 882
 883          Last_Switches.Increment_Last;
 884          Last_Switches.Table (Last_Switches.Last) :=
 885            new String'("-l" &
 886                        Get_Name_String
 887                          (Project_Tree.Projects.Table
 888                             (Project).Library_Name));
 889
 890          --  Add the directory to table Library_Paths, to be processed later
 891          --  if library is not static and if Path_Option is not null.
 892
 893          if Project_Tree.Projects.Table (Project).Library_Kind /=
 894               Static
 895            and then Path_Option /= null
 896          then
 897             Library_Paths.Increment_Last;
 898             Library_Paths.Table (Library_Paths.Last) :=
 899               new String'(Get_Name_String
 900                             (Project_Tree.Projects.Table
 901                                (Project).Library_Dir));
 902          end if;
 903       end if;
 904    end Set_Library_For;
 905
 906    ---------------------------
 907    -- Test_If_Relative_Path --
 908    ---------------------------
 909
 910    procedure Test_If_Relative_Path
 911      (Switch : in out String_Access;
 912       Parent : String)
 913    is
 914    begin
 915       if Switch /= null then
 916
 917          declare
 918             Sw : String (1 .. Switch'Length);
 919             Start : Positive := 1;
 920
 921          begin
 922             Sw := Switch.all;
 923
 924             if Sw (1) = '-' then
 925                if Sw'Length >= 3
 926                  and then (Sw (2) = 'A' or else
 927                            Sw (2) = 'I' or else
 928                            Sw (2) = 'L')
 929                then
 930                   Start := 3;
 931
 932                   if Sw = "-I-" then
 933                      return;
 934                   end if;
 935
 936                elsif Sw'Length >= 4
 937                  and then (Sw (2 .. 3) = "aL" or else
 938                            Sw (2 .. 3) = "aO" or else
 939                            Sw (2 .. 3) = "aI")
 940                then
 941                   Start := 4;
 942
 943                elsif Sw'Length >= 7
 944                  and then Sw (2 .. 6) = "-RTS="
 945                then
 946                   Start := 7;
 947                else
 948                   return;
 949                end if;
 950             end if;
 951
 952             --  If the path is relative, test if it includes directory
 953             --  information. If it does, prepend Parent to the path.
 954
 955             if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then
 956                for J in Start .. Sw'Last loop
 957                   if Sw (J) = Directory_Separator then
 958                      Switch :=
 959                         new String'
 960                               (Sw (1 .. Start - 1) &
 961                                Parent &
 962                                Directory_Separator &
 963                                Sw (Start .. Sw'Last));
 964                      return;
 965                   end if;
 966                end loop;
 967             end if;
 968          end;
 969       end if;
 970    end Test_If_Relative_Path;
 971
 972    -------------------
 973    -- Non_VMS_Usage --
 974    -------------------
 975
 976    procedure Non_VMS_Usage is
 977    begin
 978       Output_Version;
 979       New_Line;
 980       Put_Line ("List of available commands");
 981       New_Line;
 982
 983       for C in Command_List'Range loop
 984          if not Command_List (C).VMS_Only then
 985             Put ("gnat " & To_Lower (Command_List (C).Cname.all));
 986             Set_Col (25);
 987             Put (Command_List (C).Unixcmd.all);
 988
 989             declare
 990                Sws : Argument_List_Access renames Command_List (C).Unixsws;
 991             begin
 992                if Sws /= null then
 993                   for J in Sws'Range loop
 994                      Put (' ');
 995                      Put (Sws (J).all);
 996                   end loop;
 997                end if;
 998             end;
 999
1000             New_Line;
1001          end if;
1002       end loop;
1003
1004       New_Line;
1005       Put_Line ("Commands find, list, metric, pretty, stub and xref accept " &
1006                 "project file switches -vPx, -Pprj and -Xnam=val");
1007       New_Line;
1008    end Non_VMS_Usage;
1009
1010    -------------------------------------
1011    -- Start of processing for GNATCmd --
1012    -------------------------------------
1013
1014 begin
1015    --  Initializations
1016
1017    Namet.Initialize;
1018    Csets.Initialize;
1019
1020    Snames.Initialize;
1021
1022    Prj.Initialize (Project_Tree);
1023
1024    Last_Switches.Init;
1025    Last_Switches.Set_Last (0);
1026
1027    First_Switches.Init;
1028    First_Switches.Set_Last (0);
1029    Carg_Switches.Init;
1030    Carg_Switches.Set_Last (0);
1031
1032    VMS_Conv.Initialize;
1033
1034    --  Add the directory where the GNAT driver is invoked in front of the
1035    --  path, if the GNAT driver is invoked with directory information.
1036    --  Only do this if the platform is not VMS, where the notion of path
1037    --  does not really exist.
1038
1039    if not OpenVMS then
1040       declare
1041          Command : constant String := Command_Name;
1042
1043       begin
1044          for Index in reverse Command'Range loop
1045             if Command (Index) = Directory_Separator then
1046                declare
1047                   Absolute_Dir : constant String :=
1048                                    Normalize_Pathname
1049                                      (Command (Command'First .. Index));
1050
1051                   PATH         : constant String :=
1052                                    Absolute_Dir &
1053                   Path_Separator &
1054                   Getenv ("PATH").all;
1055
1056                begin
1057                   Setenv ("PATH", PATH);
1058                end;
1059
1060                exit;
1061             end if;
1062          end loop;
1063       end;
1064    end if;
1065
1066    --  If on VMS, or if VMS emulation is on, convert VMS style /qualifiers,
1067    --  filenames and pathnames to Unix style.
1068
1069    if Hostparm.OpenVMS
1070      or else To_Lower (Getenv ("EMULATE_VMS").all) = "true"
1071    then
1072       VMS_Conversion (The_Command);
1073
1074    --  If not on VMS, scan the command line directly
1075
1076    else
1077       if Argument_Count = 0 then
1078          Non_VMS_Usage;
1079          return;
1080       else
1081          begin
1082             loop
1083                if Argument_Count > Command_Arg
1084                  and then Argument (Command_Arg) = "-v"
1085                then
1086                   Verbose_Mode := True;
1087                   Command_Arg := Command_Arg + 1;
1088
1089                elsif Argument_Count > Command_Arg
1090                  and then Argument (Command_Arg) = "-dn"
1091                then
1092                   Keep_Temporary_Files := True;
1093                   Command_Arg := Command_Arg + 1;
1094
1095                else
1096                   exit;
1097                end if;
1098             end loop;
1099
1100             The_Command := Real_Command_Type'Value (Argument (Command_Arg));
1101
1102             if Command_List (The_Command).VMS_Only then
1103                Non_VMS_Usage;
1104                Fail
1105                  ("Command """,
1106                   Command_List (The_Command).Cname.all,
1107                   """ can only be used on VMS");
1108             end if;
1109
1110          exception
1111             when Constraint_Error =>
1112
1113                --  Check if it is an alternate command
1114
1115                declare
1116                   Alternate : Alternate_Command;
1117
1118                begin
1119                   Alternate := Alternate_Command'Value
1120                                               (Argument (Command_Arg));
1121                   The_Command := Corresponding_To (Alternate);
1122
1123                exception
1124                   when Constraint_Error =>
1125                      Non_VMS_Usage;
1126                      Fail ("Unknown command: ", Argument (Command_Arg));
1127                end;
1128          end;
1129
1130          --  Get the arguments from the command line and from the eventual
1131          --  argument file(s) specified on the command line.
1132
1133          for Arg in Command_Arg + 1 .. Argument_Count loop
1134             declare
1135                The_Arg : constant String := Argument (Arg);
1136
1137             begin
1138                --  Check if an argument file is specified
1139
1140                if The_Arg (The_Arg'First) = '@' then
1141                   declare
1142                      Arg_File : Ada.Text_IO.File_Type;
1143                      Line     : String (1 .. 256);
1144                      Last     : Natural;
1145
1146                   begin
1147                      --  Open the file and fail if the file cannot be found
1148
1149                      begin
1150                         Open
1151                           (Arg_File, In_File,
1152                            The_Arg (The_Arg'First + 1 .. The_Arg'Last));
1153
1154                      exception
1155                         when others =>
1156                            Put
1157                              (Standard_Error, "Cannot open argument file """);
1158                            Put
1159                              (Standard_Error,
1160                               The_Arg (The_Arg'First + 1 .. The_Arg'Last));
1161
1162                            Put_Line (Standard_Error, """");
1163                            raise Error_Exit;
1164                      end;
1165
1166                      --  Read line by line and put the content of each
1167                      --  non empty line in the Last_Switches table.
1168
1169                      while not End_Of_File (Arg_File) loop
1170                         Get_Line (Arg_File, Line, Last);
1171
1172                         if Last /= 0 then
1173                            Last_Switches.Increment_Last;
1174                            Last_Switches.Table (Last_Switches.Last) :=
1175                              new String'(Line (1 .. Last));
1176                         end if;
1177                      end loop;
1178
1179                      Close (Arg_File);
1180                   end;
1181
1182                else
1183                   --  It is not an argument file; just put the argument in
1184                   --  the Last_Switches table.
1185
1186                   Last_Switches.Increment_Last;
1187                   Last_Switches.Table (Last_Switches.Last) :=
1188                     new String'(The_Arg);
1189                end if;
1190             end;
1191          end loop;
1192       end if;
1193    end if;
1194
1195    declare
1196       Program : constant String :=
1197                   Program_Name (Command_List (The_Command).Unixcmd.all).all;
1198
1199       Exec_Path : String_Access;
1200
1201    begin
1202       --  First deal with built-in command(s)
1203
1204       if The_Command = Setup then
1205          Process_Setup :
1206          declare
1207             Arg_Num : Positive := 1;
1208             Argv    : String_Access;
1209
1210          begin
1211             while Arg_Num <= Last_Switches.Last loop
1212                Argv := Last_Switches.Table (Arg_Num);
1213
1214                if Argv (Argv'First) /= '-' then
1215                   Fail ("invalid parameter """, Argv.all, """");
1216
1217                else
1218                   if Argv'Length = 1 then
1219                      Fail
1220                        ("switch character cannot be followed by a blank");
1221                   end if;
1222
1223                   --  -vPx  Specify verbosity while parsing project files
1224
1225                   if Argv'Length = 4
1226                     and then Argv (Argv'First + 1 .. Argv'First + 2) = "vP"
1227                   then
1228                      case Argv (Argv'Last) is
1229                         when '0' =>
1230                            Current_Verbosity := Prj.Default;
1231                         when '1' =>
1232                            Current_Verbosity := Prj.Medium;
1233                         when '2' =>
1234                            Current_Verbosity := Prj.High;
1235                         when others =>
1236                            Fail ("Invalid switch: ", Argv.all);
1237                      end case;
1238
1239                   --  -Pproject_file  Specify project file to be used
1240
1241                   elsif Argv (Argv'First + 1) = 'P' then
1242
1243                      --  Only one -P switch can be used
1244
1245                      if Project_File /= null then
1246                         Fail
1247                           (Argv.all,
1248                            ": second project file forbidden (first is """,
1249                            Project_File.all & """)");
1250
1251                      elsif Argv'Length = 2 then
1252
1253                         --  There is space between -P and the project file
1254                         --  name. -P cannot be the last option.
1255
1256                         if Arg_Num = Last_Switches.Last then
1257                            Fail ("project file name missing after -P");
1258
1259                         else
1260                            Arg_Num := Arg_Num + 1;
1261                            Argv := Last_Switches.Table (Arg_Num);
1262
1263                            --  After -P, there must be a project file name,
1264                            --  not another switch.
1265
1266                            if Argv (Argv'First) = '-' then
1267                               Fail ("project file name missing after -P");
1268
1269                            else
1270                               Project_File := new String'(Argv.all);
1271                            end if;
1272                         end if;
1273
1274                      else
1275                         --  No space between -P and project file name
1276
1277                         Project_File :=
1278                           new String'(Argv (Argv'First + 2 .. Argv'Last));
1279                      end if;
1280
1281                   --  -Xexternal=value Specify an external reference to be
1282                   --                   used in project files
1283
1284                   elsif Argv'Length >= 5
1285                     and then Argv (Argv'First + 1) = 'X'
1286                   then
1287                      declare
1288                         Equal_Pos : constant Natural :=
1289                           Index ('=', Argv (Argv'First + 2 .. Argv'Last));
1290                      begin
1291                         if Equal_Pos >= Argv'First + 3 and then
1292                           Equal_Pos /= Argv'Last then
1293                            Add
1294                              (External_Name =>
1295                               Argv (Argv'First + 2 .. Equal_Pos - 1),
1296                               Value     => Argv (Equal_Pos + 1 .. Argv'Last));
1297                         else
1298                            Fail
1299                              (Argv.all,
1300                               " is not a valid external assignment.");
1301                         end if;
1302                      end;
1303
1304                   elsif Argv.all = "-v" then
1305                      Verbose_Mode := True;
1306
1307                   elsif Argv.all = "-q" then
1308                      Quiet_Output := True;
1309
1310                   else
1311                      Fail ("invalid parameter """, Argv.all, """");
1312                   end if;
1313                end if;
1314
1315                Arg_Num := Arg_Num + 1;
1316             end loop;
1317
1318             if Project_File = null then
1319                Fail ("no project file specified");
1320             end if;
1321
1322             Setup_Projects := True;
1323
1324             Prj.Pars.Set_Verbosity (To => Current_Verbosity);
1325
1326             --  Missing directories are created during processing of the
1327             --  project tree.
1328
1329             Prj.Pars.Parse
1330               (Project           => Project,
1331                In_Tree           => Project_Tree,
1332                Project_File_Name => Project_File.all,
1333                Packages_To_Check => All_Packages);
1334
1335             if Project = Prj.No_Project then
1336                Fail ("""", Project_File.all, """ processing failed");
1337             end if;
1338
1339             --  Processing is done
1340
1341             return;
1342          end Process_Setup;
1343       end if;
1344
1345       --  Locate the executable for the command
1346
1347       Exec_Path := Locate_Exec_On_Path (Program);
1348
1349       if Exec_Path = null then
1350          Put_Line (Standard_Error, "could not locate " & Program);
1351          raise Error_Exit;
1352       end if;
1353
1354       --  If there are switches for the executable, put them as first switches
1355
1356       if Command_List (The_Command).Unixsws /= null then
1357          for J in Command_List (The_Command).Unixsws'Range loop
1358             First_Switches.Increment_Last;
1359             First_Switches.Table (First_Switches.Last) :=
1360               Command_List (The_Command).Unixsws (J);
1361          end loop;
1362       end if;
1363
1364       --  For BIND, CHECK, FIND, LINK, LIST, PRETTY ad  XREF, look for project
1365       --  file related switches.
1366
1367       if The_Command = Bind
1368         or else The_Command = Check
1369         or else The_Command = Elim
1370         or else The_Command = Find
1371         or else The_Command = Link
1372         or else The_Command = List
1373         or else The_Command = Xref
1374         or else The_Command = Pretty
1375         or else The_Command = Stub
1376         or else The_Command = Metric
1377       then
1378          case The_Command is
1379             when Bind =>
1380                Tool_Package_Name := Name_Binder;
1381                Packages_To_Check := Packages_To_Check_By_Binder;
1382             when Check =>
1383                Tool_Package_Name := Name_Check;
1384                Packages_To_Check := Packages_To_Check_By_Check;
1385             when Elim =>
1386                Tool_Package_Name := Name_Eliminate;
1387                Packages_To_Check := Packages_To_Check_By_Eliminate;
1388             when Find =>
1389                Tool_Package_Name := Name_Finder;
1390                Packages_To_Check := Packages_To_Check_By_Finder;
1391             when Link =>
1392                Tool_Package_Name := Name_Linker;
1393                Packages_To_Check := Packages_To_Check_By_Linker;
1394             when List =>
1395                Tool_Package_Name := Name_Gnatls;
1396                Packages_To_Check := Packages_To_Check_By_Gnatls;
1397             when Metric =>
1398                Tool_Package_Name := Name_Metrics;
1399                Packages_To_Check := Packages_To_Check_By_Metric;
1400             when Pretty =>
1401                Tool_Package_Name := Name_Pretty_Printer;
1402                Packages_To_Check := Packages_To_Check_By_Pretty;
1403             when Stub =>
1404                Tool_Package_Name := Name_Gnatstub;
1405                Packages_To_Check := Packages_To_Check_By_Gnatstub;
1406             when Xref =>
1407                Tool_Package_Name := Name_Cross_Reference;
1408                Packages_To_Check := Packages_To_Check_By_Xref;
1409             when others =>
1410                null;
1411          end case;
1412
1413          --  Check that the switches are consistent.
1414          --  Detect project file related switches.
1415
1416          Inspect_Switches :
1417          declare
1418             Arg_Num : Positive := 1;
1419             Argv    : String_Access;
1420
1421             procedure Remove_Switch (Num : Positive);
1422             --  Remove a project related switch from table Last_Switches
1423
1424             -------------------
1425             -- Remove_Switch --
1426             -------------------
1427
1428             procedure Remove_Switch (Num : Positive) is
1429             begin
1430                Last_Switches.Table (Num .. Last_Switches.Last - 1) :=
1431                  Last_Switches.Table (Num + 1 .. Last_Switches.Last);
1432                Last_Switches.Decrement_Last;
1433             end Remove_Switch;
1434
1435          --  Start of processing for Inspect_Switches
1436
1437          begin
1438             while Arg_Num <= Last_Switches.Last loop
1439                Argv := Last_Switches.Table (Arg_Num);
1440
1441                if Argv (Argv'First) = '-' then
1442                   if Argv'Length = 1 then
1443                      Fail
1444                        ("switch character cannot be followed by a blank");
1445                   end if;
1446
1447                   --  The two style project files (-p and -P) cannot be used
1448                   --  together
1449
1450                   if (The_Command = Find or else The_Command = Xref)
1451                     and then Argv (2) = 'p'
1452                   then
1453                      Old_Project_File_Used := True;
1454                      if Project_File /= null then
1455                         Fail ("-P and -p cannot be used together");
1456                      end if;
1457                   end if;
1458
1459                   --  -vPx  Specify verbosity while parsing project files
1460
1461                   if Argv'Length = 4
1462                     and then Argv (Argv'First + 1 .. Argv'First + 2) = "vP"
1463                   then
1464                      case Argv (Argv'Last) is
1465                         when '0' =>
1466                            Current_Verbosity := Prj.Default;
1467                         when '1' =>
1468                            Current_Verbosity := Prj.Medium;
1469                         when '2' =>
1470                            Current_Verbosity := Prj.High;
1471                         when others =>
1472                            Fail ("Invalid switch: ", Argv.all);
1473                      end case;
1474
1475                      Remove_Switch (Arg_Num);
1476
1477                   --  -Pproject_file  Specify project file to be used
1478
1479                   elsif Argv (Argv'First + 1) = 'P' then
1480
1481                      --  Only one -P switch can be used
1482
1483                      if Project_File /= null then
1484                         Fail
1485                           (Argv.all,
1486                            ": second project file forbidden (first is """,
1487                            Project_File.all & """)");
1488
1489                      --  The two style project files (-p and -P) cannot be
1490                      --  used together.
1491
1492                      elsif Old_Project_File_Used then
1493                         Fail ("-p and -P cannot be used together");
1494
1495                      elsif Argv'Length = 2 then
1496
1497                         --  There is space between -P and the project file
1498                         --  name. -P cannot be the last option.
1499
1500                         if Arg_Num = Last_Switches.Last then
1501                            Fail ("project file name missing after -P");
1502
1503                         else
1504                            Remove_Switch (Arg_Num);
1505                            Argv := Last_Switches.Table (Arg_Num);
1506
1507                            --  After -P, there must be a project file name,
1508                            --  not another switch.
1509
1510                            if Argv (Argv'First) = '-' then
1511                               Fail ("project file name missing after -P");
1512
1513                            else
1514                               Project_File := new String'(Argv.all);
1515                            end if;
1516                         end if;
1517
1518                      else
1519                         --  No space between -P and project file name
1520
1521                         Project_File :=
1522                           new String'(Argv (Argv'First + 2 .. Argv'Last));
1523                      end if;
1524
1525                      Remove_Switch (Arg_Num);
1526
1527                   --  -Xexternal=value Specify an external reference to be
1528                   --                   used in project files
1529
1530                   elsif Argv'Length >= 5
1531                     and then Argv (Argv'First + 1) = 'X'
1532                   then
1533                      declare
1534                         Equal_Pos : constant Natural :=
1535                           Index ('=', Argv (Argv'First + 2 .. Argv'Last));
1536                      begin
1537                         if Equal_Pos >= Argv'First + 3 and then
1538                           Equal_Pos /= Argv'Last then
1539                            Add (External_Name =>
1540                                   Argv (Argv'First + 2 .. Equal_Pos - 1),
1541                                 Value => Argv (Equal_Pos + 1 .. Argv'Last));
1542                         else
1543                            Fail
1544                              (Argv.all,
1545                               " is not a valid external assignment.");
1546                         end if;
1547                      end;
1548
1549                      Remove_Switch (Arg_Num);
1550
1551                   elsif
1552                     (The_Command = Check  or else
1553                      The_Command = Pretty or else
1554                      The_Command = Metric)
1555                     and then Argv'Length = 2
1556                     and then Argv (2) = 'U'
1557                   then
1558                      All_Projects := True;
1559                      Remove_Switch (Arg_Num);
1560
1561                   else
1562                      Arg_Num := Arg_Num + 1;
1563                   end if;
1564
1565                else
1566                   Arg_Num := Arg_Num + 1;
1567                end if;
1568             end loop;
1569          end Inspect_Switches;
1570       end if;
1571
1572       --  If there is a project file specified, parse it, get the switches
1573       --  for the tool and setup PATH environment variables.
1574
1575       if Project_File /= null then
1576          Prj.Pars.Set_Verbosity (To => Current_Verbosity);
1577
1578          Prj.Pars.Parse
1579            (Project           => Project,
1580             In_Tree           => Project_Tree,
1581             Project_File_Name => Project_File.all,
1582             Packages_To_Check => Packages_To_Check);
1583
1584          if Project = Prj.No_Project then
1585             Fail ("""", Project_File.all, """ processing failed");
1586          end if;
1587
1588          --  Check if a package with the name of the tool is in the project
1589          --  file and if there is one, get the switches, if any, and scan them.
1590
1591          declare
1592             Data : constant Prj.Project_Data :=
1593                      Project_Tree.Projects.Table (Project);
1594
1595             Pkg : constant Prj.Package_Id :=
1596                     Prj.Util.Value_Of
1597                       (Name        => Tool_Package_Name,
1598                        In_Packages => Data.Decl.Packages,
1599                        In_Tree     => Project_Tree);
1600
1601             Element : Package_Element;
1602
1603             Default_Switches_Array : Array_Element_Id;
1604
1605             The_Switches : Prj.Variable_Value;
1606             Current      : Prj.String_List_Id;
1607             The_String   : String_Element;
1608
1609          begin
1610             if Pkg /= No_Package then
1611                Element := Project_Tree.Packages.Table (Pkg);
1612
1613                --  Packages Gnatls has a single attribute Switches, that is
1614                --  not an associative array.
1615
1616                if The_Command = List then
1617                   The_Switches :=
1618                     Prj.Util.Value_Of
1619                     (Variable_Name => Snames.Name_Switches,
1620                      In_Variables  => Element.Decl.Attributes,
1621                      In_Tree       => Project_Tree);
1622
1623                --  Packages Binder (for gnatbind), Cross_Reference (for
1624                --  gnatxref), Linker (for gnatlink) Finder (for gnatfind),
1625                --  Pretty_Printer (for gnatpp) Eliminate (for gnatelim),
1626                --  Check (for gnatcheck) and Metric (for gnatmetric) have
1627                --  an attributed Switches, an associative array, indexed
1628                --  by the name of the file.
1629
1630                --  They also have an attribute Default_Switches, indexed
1631                --  by the name of the programming language.
1632
1633                else
1634                   if The_Switches.Kind = Prj.Undefined then
1635                      Default_Switches_Array :=
1636                        Prj.Util.Value_Of
1637                          (Name      => Name_Default_Switches,
1638                           In_Arrays => Element.Decl.Arrays,
1639                           In_Tree   => Project_Tree);
1640                      The_Switches := Prj.Util.Value_Of
1641                        (Index     => Name_Ada,
1642                         Src_Index => 0,
1643                         In_Array  => Default_Switches_Array,
1644                         In_Tree   => Project_Tree);
1645                   end if;
1646                end if;
1647
1648                --  If there are switches specified in the package of the
1649                --  project file corresponding to the tool, scan them.
1650
1651                case The_Switches.Kind is
1652                   when Prj.Undefined =>
1653                      null;
1654
1655                   when Prj.Single =>
1656                      declare
1657                         Switch : constant String :=
1658                                    Get_Name_String (The_Switches.Value);
1659
1660                      begin
1661                         if Switch'Length > 0 then
1662                            First_Switches.Increment_Last;
1663                            First_Switches.Table (First_Switches.Last) :=
1664                              new String'(Switch);
1665                         end if;
1666                      end;
1667
1668                   when Prj.List =>
1669                      Current := The_Switches.Values;
1670                      while Current /= Prj.Nil_String loop
1671                         The_String := Project_Tree.String_Elements.
1672                                         Table (Current);
1673
1674                         declare
1675                            Switch : constant String :=
1676                              Get_Name_String (The_String.Value);
1677
1678                         begin
1679                            if Switch'Length > 0 then
1680                               First_Switches.Increment_Last;
1681                               First_Switches.Table (First_Switches.Last) :=
1682                                 new String'(Switch);
1683                            end if;
1684                         end;
1685
1686                         Current := The_String.Next;
1687                      end loop;
1688                end case;
1689             end if;
1690          end;
1691
1692          if The_Command = Bind
1693            or else The_Command = Link
1694            or else The_Command = Elim
1695          then
1696             Change_Dir
1697               (Get_Name_String
1698                  (Project_Tree.Projects.Table
1699                     (Project).Object_Directory));
1700          end if;
1701
1702          --  Set up the env vars for project path files
1703
1704          Prj.Env.Set_Ada_Paths
1705            (Project, Project_Tree, Including_Libraries => False);
1706
1707          --  For gnatcheck, gnatstub, gnatmetric, gnatpp and gnatelim, create
1708          --  a configuration pragmas file, if necessary.
1709
1710          if The_Command = Pretty
1711            or else The_Command = Metric
1712            or else The_Command = Stub
1713            or else The_Command = Elim
1714            or else The_Command = Check
1715          then
1716             --  If there are switches in package Compiler, put them in the
1717             --  Carg_Switches table.
1718
1719             declare
1720                Data : constant Prj.Project_Data :=
1721                         Project_Tree.Projects.Table (Project);
1722
1723                Pkg  : constant Prj.Package_Id :=
1724                         Prj.Util.Value_Of
1725                           (Name        => Name_Compiler,
1726                            In_Packages => Data.Decl.Packages,
1727                            In_Tree     => Project_Tree);
1728
1729                Element : Package_Element;
1730
1731                Default_Switches_Array : Array_Element_Id;
1732
1733                The_Switches : Prj.Variable_Value;
1734                Current      : Prj.String_List_Id;
1735                The_String   : String_Element;
1736
1737             begin
1738                if Pkg /= No_Package then
1739                   Element := Project_Tree.Packages.Table (Pkg);
1740
1741                   Default_Switches_Array :=
1742                     Prj.Util.Value_Of
1743                       (Name      => Name_Default_Switches,
1744                        In_Arrays => Element.Decl.Arrays,
1745                        In_Tree   => Project_Tree);
1746                   The_Switches := Prj.Util.Value_Of
1747                     (Index     => Name_Ada,
1748                      Src_Index => 0,
1749                      In_Array  => Default_Switches_Array,
1750                      In_Tree   => Project_Tree);
1751
1752                   --  If there are switches specified in the package of the
1753                   --  project file corresponding to the tool, scan them.
1754
1755                   case The_Switches.Kind is
1756                      when Prj.Undefined =>
1757                         null;
1758
1759                      when Prj.Single =>
1760                         declare
1761                            Switch : constant String :=
1762                                       Get_Name_String (The_Switches.Value);
1763
1764                         begin
1765                            if Switch'Length > 0 then
1766                               Add_To_Carg_Switches (new String'(Switch));
1767                            end if;
1768                         end;
1769
1770                      when Prj.List =>
1771                         Current := The_Switches.Values;
1772                         while Current /= Prj.Nil_String loop
1773                            The_String :=
1774                              Project_Tree.String_Elements.Table (Current);
1775
1776                            declare
1777                               Switch : constant String :=
1778                                          Get_Name_String (The_String.Value);
1779                            begin
1780                               if Switch'Length > 0 then
1781                                  Add_To_Carg_Switches (new String'(Switch));
1782                               end if;
1783                            end;
1784
1785                            Current := The_String.Next;
1786                         end loop;
1787                   end case;
1788                end if;
1789             end;
1790
1791             --  If -cargs is one of the switches, move the following switches
1792             --  to the Carg_Switches table.
1793
1794             for J in 1 .. First_Switches.Last loop
1795                if First_Switches.Table (J).all = "-cargs" then
1796                   for K in J + 1 .. First_Switches.Last loop
1797                      Add_To_Carg_Switches (First_Switches.Table (K));
1798                   end loop;
1799                   First_Switches.Set_Last (J - 1);
1800                   exit;
1801                end if;
1802             end loop;
1803
1804             for J in 1 .. Last_Switches.Last loop
1805                if Last_Switches.Table (J).all = "-cargs" then
1806                   for K in J + 1 .. Last_Switches.Last loop
1807                      Add_To_Carg_Switches (Last_Switches.Table (K));
1808                   end loop;
1809                   Last_Switches.Set_Last (J - 1);
1810                   exit;
1811                end if;
1812             end loop;
1813
1814             declare
1815                CP_File : constant Name_Id := Configuration_Pragmas_File;
1816
1817             begin
1818                if CP_File /= No_Name then
1819                   if The_Command = Elim then
1820                      First_Switches.Increment_Last;
1821                      First_Switches.Table (First_Switches.Last)  :=
1822                        new String'("-C" & Get_Name_String (CP_File));
1823
1824                   else
1825                      Add_To_Carg_Switches
1826                        (new String'("-gnatec=" & Get_Name_String (CP_File)));
1827                   end if;
1828                end if;
1829             end;
1830          end if;
1831
1832          if The_Command = Link then
1833             Process_Link;
1834          end if;
1835
1836          if The_Command = Link or The_Command = Bind then
1837
1838             --  For files that are specified as relative paths with directory
1839             --  information, we convert them to absolute paths, with parent
1840             --  being the current working directory if specified on the command
1841             --  line and the project directory if specified in the project
1842             --  file. This is what gnatmake is doing for linker and binder
1843             --  arguments.
1844
1845             for J in 1 .. Last_Switches.Last loop
1846                Test_If_Relative_Path
1847                  (Last_Switches.Table (J), Current_Work_Dir);
1848             end loop;
1849
1850             Get_Name_String
1851               (Project_Tree.Projects.Table (Project).Directory);
1852
1853             declare
1854                Project_Dir : constant String := Name_Buffer (1 .. Name_Len);
1855             begin
1856                for J in 1 .. First_Switches.Last loop
1857                   Test_If_Relative_Path
1858                     (First_Switches.Table (J), Project_Dir);
1859                end loop;
1860             end;
1861
1862          elsif The_Command = Stub then
1863             declare
1864                Data : constant Prj.Project_Data :=
1865                         Project_Tree.Projects.Table (Project);
1866                File_Index : Integer := 0;
1867                Dir_Index  : Integer := 0;
1868                Last       : constant Integer := Last_Switches.Last;
1869
1870             begin
1871                for Index in 1 .. Last loop
1872                   if Last_Switches.Table (Index)
1873                     (Last_Switches.Table (Index)'First) /= '-'
1874                   then
1875                      File_Index := Index;
1876                      exit;
1877                   end if;
1878                end loop;
1879
1880                --  If the naming scheme of the project file is not standard,
1881                --  and if the file name ends with the spec suffix, then
1882                --  indicate to gnatstub the name of the body file with
1883                --  a -o switch.
1884
1885                if Data.Naming.Ada_Spec_Suffix /=
1886                  Prj.Default_Ada_Spec_Suffix
1887                then
1888                   if File_Index /= 0 then
1889                      declare
1890                         Spec : constant String :=
1891                           Base_Name (Last_Switches.Table (File_Index).all);
1892                         Last : Natural := Spec'Last;
1893
1894                      begin
1895                         Get_Name_String (Data.Naming.Ada_Spec_Suffix);
1896
1897                         if Spec'Length > Name_Len
1898                           and then Spec (Last - Name_Len + 1 .. Last) =
1899                           Name_Buffer (1 .. Name_Len)
1900                         then
1901                            Last := Last - Name_Len;
1902                            Get_Name_String (Data.Naming.Ada_Body_Suffix);
1903                            Last_Switches.Increment_Last;
1904                            Last_Switches.Table (Last_Switches.Last) :=
1905                              new String'("-o");
1906                            Last_Switches.Increment_Last;
1907                            Last_Switches.Table (Last_Switches.Last) :=
1908                              new String'(Spec (Spec'First .. Last) &
1909                                            Name_Buffer (1 .. Name_Len));
1910                         end if;
1911                      end;
1912                   end if;
1913                end if;
1914
1915                --  Add the directory of the spec as the destination directory
1916                --  of the body, if there is no destination directory already
1917                --  specified.
1918
1919                if File_Index /= 0 then
1920                   for Index in File_Index + 1 .. Last loop
1921                      if Last_Switches.Table (Index)
1922                        (Last_Switches.Table (Index)'First) /= '-'
1923                      then
1924                         Dir_Index := Index;
1925                         exit;
1926                      end if;
1927                   end loop;
1928
1929                   if Dir_Index = 0 then
1930                      Last_Switches.Increment_Last;
1931                      Last_Switches.Table (Last_Switches.Last) :=
1932                        new String'
1933                              (Dir_Name (Last_Switches.Table (File_Index).all));
1934                   end if;
1935                end if;
1936             end;
1937          end if;
1938
1939          --  For gnatmetric, the generated files should be put in the object
1940          --  directory. This must be the first switch, because it may be
1941          --  overriden by a switch in package Metrics in the project file or by
1942          --  a command line option.
1943
1944          if The_Command = Metric then
1945             First_Switches.Increment_Last;
1946             First_Switches.Table (2 .. First_Switches.Last) :=
1947               First_Switches.Table (1 .. First_Switches.Last - 1);
1948             First_Switches.Table (1) :=
1949               new String'("-d=" &
1950                           Get_Name_String
1951                             (Project_Tree.Projects.Table
1952                                (Project).Object_Directory));
1953          end if;
1954
1955          --  For gnat check, gnat pretty, gnat metric ands gnat list,
1956          --  if no file has been put on the command line, call tool with all
1957          --  the sources of the main project.
1958
1959          if The_Command = Check  or else
1960             The_Command = Pretty or else
1961             The_Command = Metric or else
1962             The_Command = List
1963          then
1964             Check_Files;
1965          end if;
1966       end if;
1967
1968       --  Gather all the arguments and invoke the executable
1969
1970       declare
1971          The_Args : Argument_List
1972                       (1 .. First_Switches.Last +
1973                             Last_Switches.Last +
1974                             Carg_Switches.Last);
1975          Arg_Num  : Natural := 0;
1976
1977       begin
1978          for J in 1 .. First_Switches.Last loop
1979             Arg_Num := Arg_Num + 1;
1980             The_Args (Arg_Num) := First_Switches.Table (J);
1981          end loop;
1982
1983          for J in 1 .. Last_Switches.Last loop
1984             Arg_Num := Arg_Num + 1;
1985             The_Args (Arg_Num) := Last_Switches.Table (J);
1986          end loop;
1987
1988          for J in 1 .. Carg_Switches.Last loop
1989             Arg_Num := Arg_Num + 1;
1990             The_Args (Arg_Num) := Carg_Switches.Table (J);
1991          end loop;
1992
1993          --  If Display_Command is on, only display the generated command
1994
1995          if Display_Command then
1996             Put (Standard_Error, "generated command -->");
1997             Put (Standard_Error, Exec_Path.all);
1998
1999             for Arg in The_Args'Range loop
2000                Put (Standard_Error, " ");
2001                Put (Standard_Error, The_Args (Arg).all);
2002             end loop;
2003
2004             Put (Standard_Error, "<--");
2005             New_Line (Standard_Error);
2006             raise Normal_Exit;
2007          end if;
2008
2009          if Verbose_Mode then
2010             Output.Write_Str (Exec_Path.all);
2011
2012             for Arg in The_Args'Range loop
2013                Output.Write_Char (' ');
2014                Output.Write_Str (The_Args (Arg).all);
2015             end loop;
2016
2017             Output.Write_Eol;
2018          end if;
2019
2020          My_Exit_Status :=
2021            Exit_Status (Spawn (Exec_Path.all, The_Args));
2022          raise Normal_Exit;
2023       end;
2024    end;
2025
2026 exception
2027    when Error_Exit =>
2028       Prj.Env.Delete_All_Path_Files (Project_Tree);
2029       Delete_Temp_Config_Files;
2030       Set_Exit_Status (Failure);
2031
2032    when Normal_Exit =>
2033       Prj.Env.Delete_All_Path_Files (Project_Tree);
2034       Delete_Temp_Config_Files;
2035
2036       --  Since GNATCmd is normally called from DCL (the VMS shell), it must
2037       --  return an understandable VMS exit status. However the exit status
2038       --  returned *to* GNATCmd is a Posix style code, so we test it and return
2039       --  just a simple success or failure on VMS.
2040
2041       if Hostparm.OpenVMS and then My_Exit_Status /= Success then
2042          Set_Exit_Status (Failure);
2043       else
2044          Set_Exit_Status (My_Exit_Status);
2045       end if;
2046 end GNATCmd;