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