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-2004 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,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, 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;
  34 with Osint;    use Osint;
  35 with Output;
  36 with Prj;      use Prj;
  37 with Prj.Com;
  38 with Prj.Env;
  39 with Prj.Ext;  use Prj.Ext;
  40 with Prj.Pars;
  41 with Prj.Util; use Prj.Util;
  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_File      : String_Access;
  60    Project           : Prj.Project_Id;
  61    Current_Verbosity : Prj.Verbosity := Prj.Default;
  62    Tool_Package_Name : Name_Id       := No_Name;
  63
  64    --  This flag indicates a switch -p (for gnatxref and gnatfind) for
  65    --  an old fashioned project file. -p cannot be used in conjonction
  66    --  with -P.
  67
  68    Old_Project_File_Used : Boolean := False;
  69
  70    --  A table to keep the switches from the project file
  71
  72    package First_Switches is new Table.Table
  73      (Table_Component_Type => String_Access,
  74       Table_Index_Type     => Integer,
  75       Table_Low_Bound      => 1,
  76       Table_Initial        => 20,
  77       Table_Increment      => 100,
  78       Table_Name           => "Gnatcmd.First_Switches");
  79
  80    package Library_Paths is new Table.Table (
  81      Table_Component_Type => String_Access,
  82      Table_Index_Type     => Integer,
  83      Table_Low_Bound      => 1,
  84      Table_Initial        => 20,
  85      Table_Increment      => 100,
  86      Table_Name           => "Make.Library_Path");
  87
  88    --  Packages of project files to pass to Prj.Pars.Parse, depending on the
  89    --  tool. We allocate objects because we cannot declare aliased objects
  90    --  as we are in a procedure, not a library level package.
  91
  92    Naming_String    : constant String_Access := new String'("naming");
  93    Binder_String    : constant String_Access := new String'("binder");
  94    Eliminate_String : constant String_Access := new String'("eliminate");
  95    Finder_String    : constant String_Access := new String'("finder");
  96    Linker_String    : constant String_Access := new String'("linker");
  97    Gnatls_String    : constant String_Access := new String'("gnatls");
  98    Pretty_String    : constant String_Access := new String'("pretty_printer");
  99    Gnatstub_String  : constant String_Access := new String'("gnatstub");
 100    Xref_String      : constant String_Access := new String'("cross_reference");
 101
 102    Packages_To_Check_By_Binder   : constant String_List_Access :=
 103      new String_List'((Naming_String, Binder_String));
 104
 105    Packages_To_Check_By_Eliminate : constant String_List_Access :=
 106      new String_List'((Naming_String, Eliminate_String));
 107
 108    Packages_To_Check_By_Finder    : constant String_List_Access :=
 109      new String_List'((Naming_String, Finder_String));
 110
 111    Packages_To_Check_By_Linker    : constant String_List_Access :=
 112      new String_List'((Naming_String, Linker_String));
 113
 114    Packages_To_Check_By_Gnatls    : constant String_List_Access :=
 115      new String_List'((Naming_String, Gnatls_String));
 116
 117    Packages_To_Check_By_Pretty    : constant String_List_Access :=
 118      new String_List'((Naming_String, Pretty_String));
 119
 120    Packages_To_Check_By_Gnatstub  : constant String_List_Access :=
 121      new String_List'((Naming_String, Gnatstub_String));
 122
 123    Packages_To_Check_By_Xref      : constant String_List_Access :=
 124      new String_List'((Naming_String, Xref_String));
 125
 126    Packages_To_Check : String_List_Access := Prj.All_Packages;
 127
 128    ----------------------------------
 129    -- Declarations for GNATCMD use --
 130    ----------------------------------
 131
 132    The_Command : Command_Type;
 133
 134    Command_Arg : Positive := 1;
 135
 136    My_Exit_Status : Exit_Status := Success;
 137
 138    Current_Work_Dir : constant String := Get_Current_Dir;
 139
 140    -----------------------
 141    -- Local Subprograms --
 142    -----------------------
 143
 144    procedure Check_Relative_Executable (Name : in out String_Access);
 145    --  Check if an executable is specified as a relative path.
 146    --  If it is, and the path contains directory information, fail.
 147    --  Otherwise, prepend the exec directory.
 148    --  This procedure is only used for GNAT LINK when a project file
 149    --  is specified.
 150
 151    function Configuration_Pragmas_File return Name_Id;
 152    --  Return an argument, if there is a configuration pragmas file to be
 153    --  specified for Project, otherwise return No_Name.
 154    --  Used for gnatstub (GNAT STUB), gnatpp (GNAT PRETTY) and gnatelim
 155    --  (GNAT ELIM).
 156
 157    procedure Delete_Temp_Config_Files;
 158    --  Delete all temporary config files
 159
 160    function Index (Char : Character; Str : String) return Natural;
 161    --  Returns the first occurrence of Char in Str.
 162    --  Returns 0 if Char is not in Str.
 163
 164    procedure Non_VMS_Usage;
 165    --  Display usage for platforms other than VMS
 166
 167    procedure Set_Library_For
 168      (Project             : Project_Id;
 169       There_Are_Libraries : in out Boolean);
 170    --  If Project is a library project, add the correct
 171    --  -L and -l switches to the linker invocation.
 172
 173    procedure Set_Libraries is
 174       new For_Every_Project_Imported (Boolean, Set_Library_For);
 175    --  Add the -L and -l switches to the linker for all
 176    --  of the library projects.
 177
 178    procedure Test_If_Relative_Path
 179      (Switch : in out String_Access;
 180       Parent : String);
 181    --  Test if Switch is a relative search path switch.
 182    --  If it is and it includes directory information, prepend the path with
 183    --  Parent.This subprogram is only called when using project files.
 184
 185    -------------------------------
 186    -- Check_Relative_Executable --
 187    -------------------------------
 188
 189    procedure Check_Relative_Executable (Name : in out String_Access) is
 190       Exec_File_Name : constant String := Name.all;
 191
 192    begin
 193       if not Is_Absolute_Path (Exec_File_Name) then
 194          for Index in Exec_File_Name'Range loop
 195             if Exec_File_Name (Index) = Directory_Separator then
 196                Fail ("relative executable (""" &
 197                        Exec_File_Name &
 198                        """) with directory part not allowed " &
 199                        "when using project files");
 200             end if;
 201          end loop;
 202
 203          Get_Name_String (Projects.Table
 204                             (Project).Exec_Directory);
 205
 206          if Name_Buffer (Name_Len) /= Directory_Separator then
 207             Name_Len := Name_Len + 1;
 208             Name_Buffer (Name_Len) := Directory_Separator;
 209          end if;
 210
 211          Name_Buffer (Name_Len + 1 ..
 212                         Name_Len + Exec_File_Name'Length) :=
 213            Exec_File_Name;
 214          Name_Len := Name_Len + Exec_File_Name'Length;
 215          Name := new String'(Name_Buffer (1 .. Name_Len));
 216       end if;
 217    end Check_Relative_Executable;
 218
 219    --------------------------------
 220    -- Configuration_Pragmas_File --
 221    --------------------------------
 222
 223    function Configuration_Pragmas_File return Name_Id is
 224    begin
 225       Prj.Env.Create_Config_Pragmas_File
 226         (Project, Project, Include_Config_Files => False);
 227       return Projects.Table (Project).Config_File_Name;
 228    end Configuration_Pragmas_File;
 229
 230    ------------------------------
 231    -- Delete_Temp_Config_Files --
 232    ------------------------------
 233
 234    procedure Delete_Temp_Config_Files is
 235       Success : Boolean;
 236
 237    begin
 238       if Project /= No_Project then
 239          for Prj in 1 .. Projects.Last loop
 240             if Projects.Table (Prj).Config_File_Temp then
 241                if Opt.Verbose_Mode then
 242                   Output.Write_Str ("Deleting temp configuration file """);
 243                   Output.Write_Str (Get_Name_String
 244                                       (Projects.Table (Prj).Config_File_Name));
 245                   Output.Write_Line ("""");
 246                end if;
 247
 248                Delete_File
 249                  (Name    => Get_Name_String
 250                   (Projects.Table (Prj).Config_File_Name),
 251                   Success => Success);
 252             end if;
 253          end loop;
 254       end if;
 255    end Delete_Temp_Config_Files;
 256
 257    -----------
 258    -- Index --
 259    -----------
 260
 261    function Index (Char : Character; Str : String) return Natural is
 262    begin
 263       for Index in Str'Range loop
 264          if Str (Index) = Char then
 265             return Index;
 266          end if;
 267       end loop;
 268
 269       return 0;
 270    end Index;
 271
 272    ---------------------
 273    -- Set_Library_For --
 274    ---------------------
 275
 276    procedure Set_Library_For
 277      (Project             : Project_Id;
 278       There_Are_Libraries : in out Boolean)
 279    is
 280       Path_Option : constant String_Access :=
 281                       MLib.Linker_Library_Path_Option;
 282
 283    begin
 284       --  Case of library project
 285
 286       if Projects.Table (Project).Library then
 287          There_Are_Libraries := True;
 288
 289          --  Add the -L switch
 290
 291          Last_Switches.Increment_Last;
 292          Last_Switches.Table (Last_Switches.Last) :=
 293            new String'("-L" &
 294                        Get_Name_String
 295                        (Projects.Table (Project).Library_Dir));
 296
 297          --  Add the -l switch
 298
 299          Last_Switches.Increment_Last;
 300          Last_Switches.Table (Last_Switches.Last) :=
 301            new String'("-l" &
 302                        Get_Name_String
 303                        (Projects.Table (Project).Library_Name));
 304
 305          --  Add the directory to table Library_Paths, to be processed later
 306          --  if library is not static and if Path_Option is not null.
 307
 308          if Projects.Table (Project).Library_Kind /= Static
 309            and then Path_Option /= null
 310          then
 311             Library_Paths.Increment_Last;
 312             Library_Paths.Table (Library_Paths.Last) :=
 313               new String'(Get_Name_String
 314                             (Projects.Table (Project).Library_Dir));
 315          end if;
 316
 317       end if;
 318    end Set_Library_For;
 319
 320    ---------------------------
 321    -- Test_If_Relative_Path --
 322    ---------------------------
 323
 324    procedure Test_If_Relative_Path
 325      (Switch : in out String_Access;
 326       Parent : String)
 327    is
 328    begin
 329       if Switch /= null then
 330
 331          declare
 332             Sw : String (1 .. Switch'Length);
 333             Start : Positive := 1;
 334
 335          begin
 336             Sw := Switch.all;
 337
 338             if Sw (1) = '-' then
 339                if Sw'Length >= 3
 340                  and then (Sw (2) = 'A'
 341                            or else Sw (2) = 'I'
 342                            or else Sw (2) = 'L')
 343                then
 344                   Start := 3;
 345
 346                   if Sw = "-I-" then
 347                      return;
 348                   end if;
 349
 350                elsif Sw'Length >= 4
 351                  and then (Sw (2 .. 3) = "aL"
 352                            or else Sw (2 .. 3) = "aO"
 353                            or else Sw (2 .. 3) = "aI")
 354                then
 355                   Start := 4;
 356
 357                elsif Sw'Length >= 7
 358                  and then Sw (2 .. 6) = "-RTS="
 359                then
 360                   Start := 7;
 361                else
 362                   return;
 363                end if;
 364             end if;
 365
 366             --  If the path is relative, test if it includes directory
 367             --  information. If it does, prepend Parent to the path.
 368
 369             if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then
 370                for J in Start .. Sw'Last loop
 371                   if Sw (J) = Directory_Separator then
 372                      Switch :=
 373                         new String'
 374                               (Sw (1 .. Start - 1) &
 375                                Parent &
 376                                Directory_Separator &
 377                                Sw (Start .. Sw'Last));
 378                      return;
 379                   end if;
 380                end loop;
 381             end if;
 382          end;
 383       end if;
 384    end Test_If_Relative_Path;
 385
 386    -------------------
 387    -- Non_VMS_Usage --
 388    -------------------
 389
 390    procedure Non_VMS_Usage is
 391    begin
 392       Output_Version;
 393       New_Line;
 394       Put_Line ("List of available commands");
 395       New_Line;
 396
 397       for C in Command_List'Range loop
 398          if not Command_List (C).VMS_Only then
 399             Put ("GNAT " & Command_List (C).Cname.all);
 400             Set_Col (25);
 401             Put (Command_List (C).Unixcmd.all);
 402
 403             declare
 404                Sws : Argument_List_Access renames Command_List (C).Unixsws;
 405             begin
 406                if Sws /= null then
 407                   for J in Sws'Range loop
 408                      Put (' ');
 409                      Put (Sws (J).all);
 410                   end loop;
 411                end if;
 412             end;
 413
 414             New_Line;
 415          end if;
 416       end loop;
 417
 418       New_Line;
 419       Put_Line ("Commands FIND, LIST, PRETTY, STUB and XREF accept " &
 420                 "project file switches -vPx, -Pprj and -Xnam=val");
 421       New_Line;
 422    end Non_VMS_Usage;
 423
 424    -------------------------------------
 425    -- Start of processing for GNATCmd --
 426    -------------------------------------
 427
 428 begin
 429    --  Initializations
 430
 431    Namet.Initialize;
 432    Csets.Initialize;
 433
 434    Snames.Initialize;
 435
 436    Prj.Initialize;
 437
 438    Last_Switches.Init;
 439    Last_Switches.Set_Last (0);
 440
 441    First_Switches.Init;
 442    First_Switches.Set_Last (0);
 443
 444    VMS_Conv.Initialize;
 445
 446    --  If on VMS, or if VMS emulation is on, convert VMS style /qualifiers,
 447    --  filenames and pathnames to Unix style.
 448
 449    if Hostparm.OpenVMS
 450      or else To_Lower (Getenv ("EMULATE_VMS").all) = "true"
 451    then
 452       VMS_Conversion (The_Command);
 453
 454    --  If not on VMS, scan the command line directly
 455
 456    else
 457       if Argument_Count = 0 then
 458          Non_VMS_Usage;
 459          return;
 460       else
 461          begin
 462             if Argument_Count > 1 and then Argument (1) = "-v" then
 463                Opt.Verbose_Mode := True;
 464                Command_Arg := 2;
 465             end if;
 466
 467             The_Command := Real_Command_Type'Value (Argument (Command_Arg));
 468
 469             if Command_List (The_Command).VMS_Only then
 470                Non_VMS_Usage;
 471                Fail
 472                  ("Command """,
 473                   Command_List (The_Command).Cname.all,
 474                   """ can only be used on VMS");
 475             end if;
 476
 477          exception
 478             when Constraint_Error =>
 479
 480                --  Check if it is an alternate command
 481
 482                declare
 483                   Alternate : Alternate_Command;
 484
 485                begin
 486                   Alternate := Alternate_Command'Value
 487                                               (Argument (Command_Arg));
 488                   The_Command := Corresponding_To (Alternate);
 489
 490                exception
 491                   when Constraint_Error =>
 492                      Non_VMS_Usage;
 493                      Fail ("Unknown command: ", Argument (Command_Arg));
 494                end;
 495          end;
 496
 497          --  Get the arguments from the command line and from the eventual
 498          --  argument file(s) specified on the command line.
 499
 500          for Arg in Command_Arg + 1 .. Argument_Count loop
 501             declare
 502                The_Arg : constant String := Argument (Arg);
 503
 504             begin
 505                --  Check if an argument file is specified
 506
 507                if The_Arg (The_Arg'First) = '@' then
 508                   declare
 509                      Arg_File : Ada.Text_IO.File_Type;
 510                      Line     : String (1 .. 256);
 511                      Last     : Natural;
 512
 513                   begin
 514                      --  Open the file and fail if the file cannot be found
 515
 516                      begin
 517                         Open
 518                           (Arg_File, In_File,
 519                            The_Arg (The_Arg'First + 1 .. The_Arg'Last));
 520
 521                      exception
 522                         when others =>
 523                            Put
 524                              (Standard_Error, "Cannot open argument file """);
 525                            Put
 526                              (Standard_Error,
 527                               The_Arg (The_Arg'First + 1 .. The_Arg'Last));
 528
 529                            Put_Line (Standard_Error, """");
 530                            raise Error_Exit;
 531                      end;
 532
 533                      --  Read line by line and put the content of each
 534                      --  non empty line in the Last_Switches table.
 535
 536                      while not End_Of_File (Arg_File) loop
 537                         Get_Line (Arg_File, Line, Last);
 538
 539                         if Last /= 0 then
 540                            Last_Switches.Increment_Last;
 541                            Last_Switches.Table (Last_Switches.Last) :=
 542                              new String'(Line (1 .. Last));
 543                         end if;
 544                      end loop;
 545
 546                      Close (Arg_File);
 547                   end;
 548
 549                else
 550                   --  It is not an argument file; just put the argument in
 551                   --  the Last_Switches table.
 552
 553                   Last_Switches.Increment_Last;
 554                   Last_Switches.Table (Last_Switches.Last) :=
 555                     new String'(The_Arg);
 556                end if;
 557             end;
 558          end loop;
 559       end if;
 560    end if;
 561
 562    declare
 563       Program : constant String :=
 564                   Program_Name (Command_List (The_Command).Unixcmd.all).all;
 565
 566       Exec_Path : String_Access;
 567
 568    begin
 569       --  Locate the executable for the command
 570
 571       Exec_Path := Locate_Exec_On_Path (Program);
 572
 573       if Exec_Path = null then
 574          Put_Line (Standard_Error, "Couldn't locate " & Program);
 575          raise Error_Exit;
 576       end if;
 577
 578       --  If there are switches for the executable, put them as first switches
 579
 580       if Command_List (The_Command).Unixsws /= null then
 581          for J in Command_List (The_Command).Unixsws'Range loop
 582             First_Switches.Increment_Last;
 583             First_Switches.Table (First_Switches.Last) :=
 584               Command_List (The_Command).Unixsws (J);
 585          end loop;
 586       end if;
 587
 588       --  For BIND, FIND, LINK, LIST, PRETTY ad  XREF, look for project file
 589       --  related switches.
 590
 591       if The_Command = Bind
 592         or else The_Command = Elim
 593         or else The_Command = Find
 594         or else The_Command = Link
 595         or else The_Command = List
 596         or else The_Command = Xref
 597         or else The_Command = Pretty
 598         or else The_Command = Stub
 599       then
 600          case The_Command is
 601             when Bind =>
 602                Tool_Package_Name := Name_Binder;
 603                Packages_To_Check := Packages_To_Check_By_Binder;
 604             when Elim =>
 605                Tool_Package_Name := Name_Eliminate;
 606                Packages_To_Check := Packages_To_Check_By_Eliminate;
 607             when Find =>
 608                Tool_Package_Name := Name_Finder;
 609                Packages_To_Check := Packages_To_Check_By_Finder;
 610             when Link =>
 611                Tool_Package_Name := Name_Linker;
 612                Packages_To_Check := Packages_To_Check_By_Linker;
 613             when List =>
 614                Tool_Package_Name := Name_Gnatls;
 615                Packages_To_Check := Packages_To_Check_By_Gnatls;
 616             when Pretty =>
 617                Tool_Package_Name := Name_Pretty_Printer;
 618                Packages_To_Check := Packages_To_Check_By_Pretty;
 619             when Stub =>
 620                Tool_Package_Name := Name_Gnatstub;
 621                Packages_To_Check := Packages_To_Check_By_Gnatstub;
 622             when Xref =>
 623                Tool_Package_Name := Name_Cross_Reference;
 624                Packages_To_Check := Packages_To_Check_By_Xref;
 625             when others =>
 626                null;
 627          end case;
 628
 629          --  Check that the switches are consistent.
 630          --  Detect project file related switches.
 631
 632          Inspect_Switches :
 633          declare
 634             Arg_Num : Positive := 1;
 635             Argv    : String_Access;
 636
 637             procedure Remove_Switch (Num : Positive);
 638             --  Remove a project related switch from table Last_Switches
 639
 640             -------------------
 641             -- Remove_Switch --
 642             -------------------
 643
 644             procedure Remove_Switch (Num : Positive) is
 645             begin
 646                Last_Switches.Table (Num .. Last_Switches.Last - 1) :=
 647                  Last_Switches.Table (Num + 1 .. Last_Switches.Last);
 648                Last_Switches.Decrement_Last;
 649             end Remove_Switch;
 650
 651          --  Start of processing for Inspect_Switches
 652
 653          begin
 654             while Arg_Num <= Last_Switches.Last loop
 655                Argv := Last_Switches.Table (Arg_Num);
 656
 657                if Argv (Argv'First) = '-' then
 658                   if Argv'Length = 1 then
 659                      Fail
 660                        ("switch character cannot be followed by a blank");
 661                   end if;
 662
 663                   --  The two style project files (-p and -P) cannot be used
 664                   --  together
 665
 666                   if (The_Command = Find or else The_Command = Xref)
 667                     and then Argv (2) = 'p'
 668                   then
 669                      Old_Project_File_Used := True;
 670                      if Project_File /= null then
 671                         Fail ("-P and -p cannot be used together");
 672                      end if;
 673                   end if;
 674
 675                   --  -vPx  Specify verbosity while parsing project files
 676
 677                   if Argv'Length = 4
 678                     and then Argv (Argv'First + 1 .. Argv'First + 2) = "vP"
 679                   then
 680                      case Argv (Argv'Last) is
 681                         when '0' =>
 682                            Current_Verbosity := Prj.Default;
 683                         when '1' =>
 684                            Current_Verbosity := Prj.Medium;
 685                         when '2' =>
 686                            Current_Verbosity := Prj.High;
 687                         when others =>
 688                            Fail ("Invalid switch: ", Argv.all);
 689                      end case;
 690
 691                      Remove_Switch (Arg_Num);
 692
 693                   --  -Pproject_file  Specify project file to be used
 694
 695                   elsif Argv (Argv'First + 1) = 'P' then
 696
 697                      --  Only one -P switch can be used
 698
 699                      if Project_File /= null then
 700                         Fail
 701                           (Argv.all,
 702                            ": second project file forbidden (first is """,
 703                            Project_File.all & """)");
 704
 705                      --  The two style project files (-p and -P) cannot be
 706                      --  used together.
 707
 708                      elsif Old_Project_File_Used then
 709                         Fail ("-p and -P cannot be used together");
 710
 711                      elsif Argv'Length = 2 then
 712
 713                         --  There is space between -P and the project file
 714                         --  name. -P cannot be the last option.
 715
 716                         if Arg_Num = Last_Switches.Last then
 717                            Fail ("project file name missing after -P");
 718
 719                         else
 720                            Remove_Switch (Arg_Num);
 721                            Argv := Last_Switches.Table (Arg_Num);
 722
 723                            --  After -P, there must be a project file name,
 724                            --  not another switch.
 725
 726                            if Argv (Argv'First) = '-' then
 727                               Fail ("project file name missing after -P");
 728
 729                            else
 730                               Project_File := new String'(Argv.all);
 731                            end if;
 732                         end if;
 733
 734                      else
 735                         --  No space between -P and project file name
 736
 737                         Project_File :=
 738                           new String'(Argv (Argv'First + 2 .. Argv'Last));
 739                      end if;
 740
 741                      Remove_Switch (Arg_Num);
 742
 743                   --  -Xexternal=value Specify an external reference to be
 744                   --                   used in project files
 745
 746                   elsif Argv'Length >= 5
 747                     and then Argv (Argv'First + 1) = 'X'
 748                   then
 749                      declare
 750                         Equal_Pos : constant Natural :=
 751                           Index ('=', Argv (Argv'First + 2 .. Argv'Last));
 752                      begin
 753                         if Equal_Pos >= Argv'First + 3 and then
 754                           Equal_Pos /= Argv'Last then
 755                            Add (External_Name =>
 756                                   Argv (Argv'First + 2 .. Equal_Pos - 1),
 757                                 Value => Argv (Equal_Pos + 1 .. Argv'Last));
 758                         else
 759                            Fail
 760                              (Argv.all,
 761                               " is not a valid external assignment.");
 762                         end if;
 763                      end;
 764
 765                      Remove_Switch (Arg_Num);
 766
 767                   else
 768                      Arg_Num := Arg_Num + 1;
 769                   end if;
 770
 771                else
 772                   Arg_Num := Arg_Num + 1;
 773                end if;
 774             end loop;
 775          end Inspect_Switches;
 776       end if;
 777
 778       --  If there is a project file specified, parse it, get the switches
 779       --  for the tool and setup PATH environment variables.
 780
 781       if Project_File /= null then
 782          Prj.Pars.Set_Verbosity (To => Current_Verbosity);
 783
 784          Prj.Pars.Parse
 785            (Project           => Project,
 786             Project_File_Name => Project_File.all,
 787             Packages_To_Check => Packages_To_Check);
 788
 789          if Project = Prj.No_Project then
 790             Fail ("""", Project_File.all, """ processing failed");
 791          end if;
 792
 793          --  Check if a package with the name of the tool is in the project
 794          --  file and if there is one, get the switches, if any, and scan them.
 795
 796          declare
 797             Data : constant Prj.Project_Data :=
 798                      Prj.Projects.Table (Project);
 799
 800             Pkg : constant Prj.Package_Id :=
 801                     Prj.Util.Value_Of
 802                       (Name        => Tool_Package_Name,
 803                        In_Packages => Data.Decl.Packages);
 804
 805             Element : Package_Element;
 806
 807             Default_Switches_Array : Array_Element_Id;
 808
 809             The_Switches : Prj.Variable_Value;
 810             Current      : Prj.String_List_Id;
 811             The_String   : String_Element;
 812
 813          begin
 814             if Pkg /= No_Package then
 815                Element := Packages.Table (Pkg);
 816
 817                --  Packages Gnatls has a single attribute Switches, that is
 818                --  not an associative array.
 819
 820                if The_Command = List then
 821                   The_Switches :=
 822                     Prj.Util.Value_Of
 823                     (Variable_Name => Snames.Name_Switches,
 824                      In_Variables => Element.Decl.Attributes);
 825
 826                --  Packages Binder (for gnatbind), Cross_Reference (for
 827                --  gnatxref), Linker (for gnatlink) Finder (for gnatfind),
 828                --  Pretty_Printer (for gnatpp) and Eliminate (for gnatelim)
 829                --  have an attributed Switches, an associative array, indexed
 830                --  by the name of the file.
 831
 832                --  They also have an attribute Default_Switches, indexed
 833                --  by the name of the programming language.
 834
 835                else
 836                   if The_Switches.Kind = Prj.Undefined then
 837                      Default_Switches_Array :=
 838                        Prj.Util.Value_Of
 839                          (Name => Name_Default_Switches,
 840                           In_Arrays => Element.Decl.Arrays);
 841                      The_Switches := Prj.Util.Value_Of
 842                        (Index     => Name_Ada,
 843                         Src_Index => 0,
 844                         In_Array  => Default_Switches_Array);
 845                   end if;
 846                end if;
 847
 848                --  If there are switches specified in the package of the
 849                --  project file corresponding to the tool, scan them.
 850
 851                case The_Switches.Kind is
 852                   when Prj.Undefined =>
 853                      null;
 854
 855                   when Prj.Single =>
 856                      declare
 857                         Switch : constant String :=
 858                                    Get_Name_String (The_Switches.Value);
 859
 860                      begin
 861                         if Switch'Length > 0 then
 862                            First_Switches.Increment_Last;
 863                            First_Switches.Table (First_Switches.Last) :=
 864                              new String'(Switch);
 865                         end if;
 866                      end;
 867
 868                   when Prj.List =>
 869                      Current := The_Switches.Values;
 870                      while Current /= Prj.Nil_String loop
 871                         The_String := String_Elements.Table (Current);
 872
 873                         declare
 874                            Switch : constant String :=
 875                              Get_Name_String (The_String.Value);
 876
 877                         begin
 878                            if Switch'Length > 0 then
 879                               First_Switches.Increment_Last;
 880                               First_Switches.Table (First_Switches.Last) :=
 881                                 new String'(Switch);
 882                            end if;
 883                         end;
 884
 885                         Current := The_String.Next;
 886                      end loop;
 887                end case;
 888             end if;
 889          end;
 890
 891          if The_Command = Bind
 892            or else The_Command = Link
 893            or else The_Command = Elim
 894          then
 895             Change_Dir
 896               (Get_Name_String
 897                  (Projects.Table (Project).Object_Directory));
 898          end if;
 899
 900          --  Set up the env vars for project path files
 901
 902          Prj.Env.Set_Ada_Paths (Project, Including_Libraries => False);
 903
 904          --  For gnatstub, gnatpp and gnatelim, create a configuration pragmas
 905          --  file, if necessary.
 906
 907          if The_Command = Pretty
 908            or else The_Command = Stub
 909            or else The_Command = Elim
 910          then
 911             declare
 912                CP_File : constant Name_Id := Configuration_Pragmas_File;
 913
 914             begin
 915                if CP_File /= No_Name then
 916                   First_Switches.Increment_Last;
 917
 918                   if The_Command = Elim then
 919                      First_Switches.Table (First_Switches.Last)  :=
 920                        new String'("-C" & Get_Name_String (CP_File));
 921
 922                   else
 923                      First_Switches.Table (First_Switches.Last) :=
 924                        new String'("-gnatec=" & Get_Name_String (CP_File));
 925                   end if;
 926                end if;
 927             end;
 928          end if;
 929
 930          if The_Command = Link then
 931
 932             --  Add the default search directories, to be able to find
 933             --  libgnat in call to MLib.Utl.Lib_Directory.
 934
 935             Add_Default_Search_Dirs;
 936
 937             declare
 938                There_Are_Libraries  : Boolean := False;
 939                Path_Option : constant String_Access :=
 940                                MLib.Linker_Library_Path_Option;
 941
 942             begin
 943                Library_Paths.Set_Last (0);
 944
 945                --  Check if there are library project files
 946
 947                if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then
 948                   Set_Libraries (Project, There_Are_Libraries);
 949                end if;
 950
 951                --  If there are, add the necessary additional switches
 952
 953                if There_Are_Libraries then
 954
 955                   --  Add -L<lib_dir> -lgnarl -lgnat -Wl,-rpath,<lib_dir>
 956
 957                   Last_Switches.Increment_Last;
 958                   Last_Switches.Table (Last_Switches.Last) :=
 959                     new String'("-L" & MLib.Utl.Lib_Directory);
 960                   Last_Switches.Increment_Last;
 961                   Last_Switches.Table (Last_Switches.Last) :=
 962                     new String'("-lgnarl");
 963                   Last_Switches.Increment_Last;
 964                   Last_Switches.Table (Last_Switches.Last) :=
 965                     new String'("-lgnat");
 966
 967                   --  If Path_Option is not null, create the switch
 968                   --  ("-Wl,-rpath," or equivalent) with all the library dirs
 969                   --  plus the standard GNAT library dir.
 970
 971                   if Path_Option /= null then
 972                      declare
 973                         Option : String_Access;
 974                         Length : Natural := Path_Option'Length;
 975                         Current : Natural;
 976
 977                      begin
 978                         --  First, compute the exact length for the switch
 979
 980                         for Index in
 981                           Library_Paths.First .. Library_Paths.Last
 982                         loop
 983                            --  Add the length of the library dir plus one
 984                            --  for the directory separator.
 985
 986                            Length :=
 987                              Length +
 988                              Library_Paths.Table (Index)'Length + 1;
 989                         end loop;
 990
 991                         --  Finally, add the length of the standard GNAT
 992                         --  library dir.
 993
 994                         Length := Length + MLib.Utl.Lib_Directory'Length;
 995                         Option := new String (1 .. Length);
 996                         Option (1 .. Path_Option'Length) := Path_Option.all;
 997                         Current := Path_Option'Length;
 998
 999                         --  Put each library dir followed by a dir separator
1000
1001                         for Index in
1002                           Library_Paths.First .. Library_Paths.Last
1003                         loop
1004                            Option
1005                              (Current + 1 ..
1006                                 Current +
1007                                 Library_Paths.Table (Index)'Length) :=
1008                              Library_Paths.Table (Index).all;
1009                            Current :=
1010                              Current +
1011                              Library_Paths.Table (Index)'Length + 1;
1012                            Option (Current) := Path_Separator;
1013                         end loop;
1014
1015                         --  Finally put the standard GNAT library dir
1016
1017                         Option
1018                           (Current + 1 ..
1019                              Current + MLib.Utl.Lib_Directory'Length) :=
1020                           MLib.Utl.Lib_Directory;
1021
1022                         --  And add the switch to the last switches
1023
1024                         Last_Switches.Increment_Last;
1025                         Last_Switches.Table (Last_Switches.Last) :=
1026                           Option;
1027                      end;
1028                   end if;
1029                end if;
1030             end;
1031
1032             --  Check if the first ALI file specified can be found, either
1033             --  in the object directory of the main project or in an object
1034             --  directory of a project file extended by the main project.
1035             --  If the ALI file can be found, replace its name with its
1036             --  absolute path.
1037
1038             declare
1039                Skip_Executable : Boolean := False;
1040
1041             begin
1042                Switch_Loop : for J in 1 .. Last_Switches.Last loop
1043
1044                   --  If we have an executable just reset the flag
1045
1046                   if Skip_Executable then
1047                      Skip_Executable := False;
1048
1049                   --  If -o, set flag so that next switch is not processed
1050
1051                   elsif Last_Switches.Table (J).all = "-o" then
1052                      Skip_Executable := True;
1053
1054                   --  Normal case
1055
1056                   else
1057                      declare
1058                         Switch : constant String :=
1059                                    Last_Switches.Table (J).all;
1060
1061                         ALI_File : constant String (1 .. Switch'Length + 4) :=
1062                                      Switch & ".ali";
1063
1064                         Last           : Natural := Switch'Length;
1065                         Test_Existence : Boolean := False;
1066
1067                      begin
1068                         --  Skip real switches
1069
1070                         if Switch'Length /= 0 and then
1071                           Switch (Switch'First) /= '-'
1072                         then
1073                            --  Append ".ali" if file name does not end with it
1074
1075                            if Switch'Length <= 4 or else
1076                              Switch (Switch'Last - 3 .. Switch'Last) /= ".ali"
1077                            then
1078                               Last := ALI_File'Last;
1079                            end if;
1080
1081                            --  If file name includes directory information,
1082                            --  stop if ALI file exists.
1083
1084                            if Is_Absolute_Path (ALI_File (1 .. Last)) then
1085                               Test_Existence := True;
1086
1087                            else
1088                               for K in Switch'Range loop
1089                                  if Switch (K) = '/' or else
1090                                    Switch (K) = Directory_Separator
1091                                  then
1092                                     Test_Existence := True;
1093                                     exit;
1094                                  end if;
1095                               end loop;
1096                            end if;
1097
1098                            if Test_Existence then
1099                               if Is_Regular_File (ALI_File (1 .. Last)) then
1100                                  exit Switch_Loop;
1101                               end if;
1102
1103                            else
1104                               --  Look in the object directories if the ALI
1105                               --  file exists.
1106
1107                               declare
1108                                  Prj : Project_Id := Project;
1109                               begin
1110                                  Project_Loop :
1111                                  loop
1112                                     declare
1113                                        Dir : constant String :=
1114                                          Get_Name_String
1115                                            (Projects.Table (Prj).
1116                                               Object_Directory);
1117                                     begin
1118                                        if Is_Regular_File
1119                                          (Dir & Directory_Separator &
1120                                           ALI_File (1 .. Last))
1121                                        then
1122                                           --  We have found the correct
1123                                           --  project, so we replace the file
1124                                           --  with the absolute path.
1125
1126                                           Last_Switches.Table (J) :=
1127                                             new String'
1128                                               (Dir & Directory_Separator &
1129                                                ALI_File (1 .. Last));
1130
1131                                           --  And we are done
1132
1133                                           exit Switch_Loop;
1134                                        end if;
1135                                     end;
1136
1137                                     --  Go to the project being extended,
1138                                     --  if any.
1139
1140                                     Prj := Projects.Table (Prj).Extends;
1141                                     exit Project_Loop when Prj = No_Project;
1142                                  end loop Project_Loop;
1143                               end;
1144                            end if;
1145                         end if;
1146                      end;
1147                   end if;
1148                end loop Switch_Loop;
1149             end;
1150
1151             --  If a relative path output file has been specified, we add
1152             --  the exec directory.
1153
1154             declare
1155                Look_For_Executable : Boolean := True;
1156
1157             begin
1158
1159                for J in reverse 1 .. Last_Switches.Last - 1 loop
1160                   if Last_Switches.Table (J).all = "-o" then
1161                      Check_Relative_Executable
1162                        (Name => Last_Switches.Table (J + 1));
1163                      Look_For_Executable := False;
1164                      exit;
1165                   end if;
1166                end loop;
1167
1168                if Look_For_Executable then
1169                   for J in reverse 1 .. First_Switches.Last - 1 loop
1170                      if First_Switches.Table (J).all = "-o" then
1171                         Look_For_Executable := False;
1172                         Check_Relative_Executable
1173                           (Name => First_Switches.Table (J + 1));
1174                         exit;
1175                      end if;
1176                   end loop;
1177                end if;
1178
1179                --  If no executable is specified, then find the name
1180                --  of the first ALI file on the command line and issue
1181                --  a -o switch with the absolute path of the executable
1182                --  in the exec directory.
1183
1184                if Look_For_Executable then
1185                   for J in 1 .. Last_Switches.Last loop
1186                      declare
1187                         Arg  : constant String_Access :=
1188                                  Last_Switches.Table (J);
1189                         Last : Natural := 0;
1190
1191                      begin
1192                         if Arg'Length /= 0 and then Arg (Arg'First) /= '-' then
1193                            if Arg'Length > 4
1194                              and then Arg (Arg'Last - 3 .. Arg'Last) = ".ali"
1195                            then
1196                               Last := Arg'Last - 4;
1197
1198                            elsif Is_Regular_File (Arg.all & ".ali") then
1199                               Last := Arg'Last;
1200                            end if;
1201
1202                            if Last /= 0 then
1203                               declare
1204                                  Executable_Name : constant String :=
1205                                    Base_Name (Arg (Arg'First .. Last));
1206                               begin
1207                                  Last_Switches.Increment_Last;
1208                                  Last_Switches.Table (Last_Switches.Last) :=
1209                                    new String'("-o");
1210                                  Get_Name_String
1211                                    (Projects.Table (Project).Exec_Directory);
1212                                  Last_Switches.Increment_Last;
1213                                  Last_Switches.Table (Last_Switches.Last) :=
1214                                     new String'(Name_Buffer (1 .. Name_Len) &
1215                                                   Directory_Separator &
1216                                                   Executable_Name &
1217                                                   Get_Executable_Suffix.all);
1218                                  exit;
1219                               end;
1220                            end if;
1221                         end if;
1222                      end;
1223                   end loop;
1224                end if;
1225             end;
1226          end if;
1227
1228          if The_Command = Link or The_Command = Bind then
1229
1230             --  For files that are specified as relative paths with directory
1231             --  information, we convert them to absolute paths, with parent
1232             --  being the current working directory if specified on the command
1233             --  line and the project directory if specified in the project
1234             --  file. This is what gnatmake is doing for linker and binder
1235             --  arguments.
1236
1237             for J in 1 .. Last_Switches.Last loop
1238                Test_If_Relative_Path
1239                  (Last_Switches.Table (J), Current_Work_Dir);
1240             end loop;
1241
1242             Get_Name_String (Projects.Table (Project).Directory);
1243
1244             declare
1245                Project_Dir : constant String := Name_Buffer (1 .. Name_Len);
1246
1247             begin
1248                for J in 1 .. First_Switches.Last loop
1249                   Test_If_Relative_Path
1250                     (First_Switches.Table (J), Project_Dir);
1251                end loop;
1252             end;
1253
1254          elsif The_Command = Stub then
1255             declare
1256                Data : constant Prj.Project_Data :=
1257                         Prj.Projects.Table (Project);
1258                File_Index : Integer := 0;
1259                Dir_Index  : Integer := 0;
1260                Last       : constant Integer := Last_Switches.Last;
1261
1262             begin
1263                for Index in 1 .. Last loop
1264                   if Last_Switches.Table (Index)
1265                     (Last_Switches.Table (Index)'First) /= '-'
1266                   then
1267                      File_Index := Index;
1268                      exit;
1269                   end if;
1270                end loop;
1271
1272                --  If the naming scheme of the project file is not standard,
1273                --  and if the file name ends with the spec suffix, then
1274                --  indicate to gnatstub the name of the body file with
1275                --  a -o switch.
1276
1277                if Data.Naming.Current_Spec_Suffix /=
1278                  Prj.Default_Ada_Spec_Suffix
1279                then
1280                   if File_Index /= 0 then
1281                      declare
1282                         Spec : constant String :=
1283                           Base_Name (Last_Switches.Table (File_Index).all);
1284                         Last : Natural := Spec'Last;
1285
1286                      begin
1287                         Get_Name_String (Data.Naming.Current_Spec_Suffix);
1288
1289                         if Spec'Length > Name_Len
1290                           and then Spec (Last - Name_Len + 1 .. Last) =
1291                           Name_Buffer (1 .. Name_Len)
1292                         then
1293                            Last := Last - Name_Len;
1294                            Get_Name_String (Data.Naming.Current_Body_Suffix);
1295                            Last_Switches.Increment_Last;
1296                            Last_Switches.Table (Last_Switches.Last) :=
1297                              new String'("-o");
1298                            Last_Switches.Increment_Last;
1299                            Last_Switches.Table (Last_Switches.Last) :=
1300                              new String'(Spec (Spec'First .. Last) &
1301                                            Name_Buffer (1 .. Name_Len));
1302                         end if;
1303                      end;
1304                   end if;
1305                end if;
1306
1307                --  Add the directory of the spec as the destination directory
1308                --  of the body, if there is no destination directory already
1309                --  specified.
1310
1311                if File_Index /= 0 then
1312                   for Index in File_Index + 1 .. Last loop
1313                      if Last_Switches.Table (Index)
1314                        (Last_Switches.Table (Index)'First) /= '-'
1315                      then
1316                         Dir_Index := Index;
1317                         exit;
1318                      end if;
1319                   end loop;
1320
1321                   if Dir_Index = 0 then
1322                      Last_Switches.Increment_Last;
1323                      Last_Switches.Table (Last_Switches.Last) :=
1324                        new String'
1325                              (Dir_Name (Last_Switches.Table (File_Index).all));
1326                   end if;
1327                end if;
1328             end;
1329          end if;
1330
1331          --  For gnat pretty, if no file has been put on the command line,
1332          --  call gnatpp with all the sources of the main project.
1333
1334          if The_Command = Pretty then
1335             declare
1336                Add_Sources : Boolean := True;
1337                Unit_Data   : Prj.Com.Unit_Data;
1338             begin
1339                --  Check if there is at least one argument that is not a switch
1340
1341                for Index in 1 .. Last_Switches.Last loop
1342                   if Last_Switches.Table (Index)(1) /= '-' then
1343                      Add_Sources := False;
1344                      exit;
1345                   end if;
1346                end loop;
1347
1348                --  If all arguments were switches, add the path names of
1349                --  all the sources of the main project.
1350
1351                if Add_Sources then
1352                   for Unit in 1 .. Prj.Com.Units.Last loop
1353                      Unit_Data := Prj.Com.Units.Table (Unit);
1354
1355                      for Kind in Prj.Com.Spec_Or_Body loop
1356
1357                         --  Put only sources that belong to the main project
1358
1359                         if Unit_Data.File_Names (Kind).Project = Project then
1360                            Last_Switches.Increment_Last;
1361                            Last_Switches.Table (Last_Switches.Last) :=
1362                              new String'
1363                                (Get_Name_String
1364                                   (Unit_Data.File_Names (Kind).Display_Path));
1365                         end if;
1366                      end loop;
1367                   end loop;
1368                end if;
1369             end;
1370          end if;
1371       end if;
1372
1373       --  Gather all the arguments and invoke the executable
1374
1375       declare
1376          The_Args : Argument_List
1377            (1 .. First_Switches.Last + Last_Switches.Last);
1378          Arg_Num : Natural := 0;
1379       begin
1380          for J in 1 .. First_Switches.Last loop
1381             Arg_Num := Arg_Num + 1;
1382             The_Args (Arg_Num) := First_Switches.Table (J);
1383          end loop;
1384
1385          for J in 1 .. Last_Switches.Last loop
1386             Arg_Num := Arg_Num + 1;
1387             The_Args (Arg_Num) := Last_Switches.Table (J);
1388          end loop;
1389
1390          --  If Display_Command is on, only display the generated command
1391
1392          if Display_Command then
1393             Put (Standard_Error, "generated command -->");
1394             Put (Standard_Error, Exec_Path.all);
1395
1396             for Arg in The_Args'Range loop
1397                Put (Standard_Error, " ");
1398                Put (Standard_Error, The_Args (Arg).all);
1399             end loop;
1400
1401             Put (Standard_Error, "<--");
1402             New_Line (Standard_Error);
1403             raise Normal_Exit;
1404          end if;
1405
1406          if Opt.Verbose_Mode then
1407             Output.Write_Str (Exec_Path.all);
1408
1409             for Arg in The_Args'Range loop
1410                Output.Write_Char (' ');
1411                Output.Write_Str (The_Args (Arg).all);
1412             end loop;
1413
1414             Output.Write_Eol;
1415          end if;
1416
1417          My_Exit_Status :=
1418            Exit_Status (Spawn (Exec_Path.all, The_Args));
1419          raise Normal_Exit;
1420       end;
1421    end;
1422
1423 exception
1424    when Error_Exit =>
1425       Prj.Env.Delete_All_Path_Files;
1426       Delete_Temp_Config_Files;
1427       Set_Exit_Status (Failure);
1428
1429    when Normal_Exit =>
1430       Prj.Env.Delete_All_Path_Files;
1431       Delete_Temp_Config_Files;
1432
1433       --  Since GNATCmd is normally called from DCL (the VMS shell),
1434       --  it must return an understandable VMS exit status. However
1435       --  the exit status returned *to* GNATCmd is a Posix style code,
1436       --  so we test it and return just a simple success or failure on VMS.
1437
1438       if Hostparm.OpenVMS and then My_Exit_Status /= Success then
1439          Set_Exit_Status (Failure);
1440       else
1441          Set_Exit_Status (My_Exit_Status);
1442       end if;
1443 end GNATCmd;