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