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
 503             begin
 504                --  Check if an argument file is specified
 505
 506                if The_Arg (The_Arg'First) = '@' then
 507                   declare
 508                      Arg_File : Ada.Text_IO.File_Type;
 509                      Line     : String (1 .. 256);
 510                      Last     : Natural;
 511
 512                   begin
 513                      --  Open the file and fail if the file cannot be found
 514
 515                      begin
 516                         Open
 517                           (Arg_File, In_File,
 518                            The_Arg (The_Arg'First + 1 .. The_Arg'Last));
 519
 520                      exception
 521                         when others =>
 522                            Put
 523                              (Standard_Error, "Cannot open argument file """);
 524                            Put
 525                              (Standard_Error,
 526                               The_Arg (The_Arg'First + 1 .. The_Arg'Last));
 527
 528                            Put_Line (Standard_Error, """");
 529                            raise Error_Exit;
 530                      end;
 531
 532                      --  Read line by line and put the content of each
 533                      --  non empty line in the Last_Switches table.
 534
 535                      while not End_Of_File (Arg_File) loop
 536                         Get_Line (Arg_File, Line, Last);
 537
 538                         if Last /= 0 then
 539                            Last_Switches.Increment_Last;
 540                            Last_Switches.Table (Last_Switches.Last) :=
 541                              new String'(Line (1 .. Last));
 542                         end if;
 543                      end loop;
 544
 545                      Close (Arg_File);
 546                   end;
 547
 548                else
 549                   --  It is not an argument file; just put the argument in
 550                   --  the Last_Switches table.
 551
 552                   Last_Switches.Increment_Last;
 553                   Last_Switches.Table (Last_Switches.Last) :=
 554                     new String'(The_Arg);
 555                end if;
 556             end;
 557          end loop;
 558       end if;
 559    end if;
 560
 561    declare
 562       Program : constant String :=
 563                   Program_Name (Command_List (The_Command).Unixcmd.all).all;
 564
 565       Exec_Path : String_Access;
 566
 567    begin
 568       --  Locate the executable for the command
 569
 570       Exec_Path := Locate_Exec_On_Path (Program);
 571
 572       if Exec_Path = null then
 573          Put_Line (Standard_Error, "Couldn't locate " & Program);
 574          raise Error_Exit;
 575       end if;
 576
 577       --  If there are switches for the executable, put them as first switches
 578
 579       if Command_List (The_Command).Unixsws /= null then
 580          for J in Command_List (The_Command).Unixsws'Range loop
 581             First_Switches.Increment_Last;
 582             First_Switches.Table (First_Switches.Last) :=
 583               Command_List (The_Command).Unixsws (J);
 584          end loop;
 585       end if;
 586
 587       --  For BIND, FIND, LINK, LIST, PRETTY ad  XREF, look for project file
 588       --  related switches.
 589
 590       if The_Command = Bind
 591         or else The_Command = Elim
 592         or else The_Command = Find
 593         or else The_Command = Link
 594         or else The_Command = List
 595         or else The_Command = Xref
 596         or else The_Command = Pretty
 597         or else The_Command = Stub
 598       then
 599          case The_Command is
 600             when Bind =>
 601                Tool_Package_Name := Name_Binder;
 602                Packages_To_Check := Packages_To_Check_By_Binder;
 603             when Elim =>
 604                Tool_Package_Name := Name_Eliminate;
 605                Packages_To_Check := Packages_To_Check_By_Eliminate;
 606             when Find =>
 607                Tool_Package_Name := Name_Finder;
 608                Packages_To_Check := Packages_To_Check_By_Finder;
 609             when Link =>
 610                Tool_Package_Name := Name_Linker;
 611                Packages_To_Check := Packages_To_Check_By_Linker;
 612             when List =>
 613                Tool_Package_Name := Name_Gnatls;
 614                Packages_To_Check := Packages_To_Check_By_Gnatls;
 615             when Pretty =>
 616                Tool_Package_Name := Name_Pretty_Printer;
 617                Packages_To_Check := Packages_To_Check_By_Pretty;
 618             when Stub =>
 619                Tool_Package_Name := Name_Gnatstub;
 620                Packages_To_Check := Packages_To_Check_By_Gnatstub;
 621             when Xref =>
 622                Tool_Package_Name := Name_Cross_Reference;
 623                Packages_To_Check := Packages_To_Check_By_Xref;
 624             when others =>
 625                null;
 626          end case;
 627
 628          --  Check that the switches are consistent.
 629          --  Detect project file related switches.
 630
 631          Inspect_Switches :
 632          declare
 633             Arg_Num : Positive := 1;
 634             Argv    : String_Access;
 635
 636             procedure Remove_Switch (Num : Positive);
 637             --  Remove a project related switch from table Last_Switches
 638
 639             -------------------
 640             -- Remove_Switch --
 641             -------------------
 642
 643             procedure Remove_Switch (Num : Positive) is
 644             begin
 645                Last_Switches.Table (Num .. Last_Switches.Last - 1) :=
 646                  Last_Switches.Table (Num + 1 .. Last_Switches.Last);
 647                Last_Switches.Decrement_Last;
 648             end Remove_Switch;
 649
 650          --  Start of processing for Inspect_Switches
 651
 652          begin
 653             while Arg_Num <= Last_Switches.Last loop
 654                Argv := Last_Switches.Table (Arg_Num);
 655
 656                if Argv (Argv'First) = '-' then
 657                   if Argv'Length = 1 then
 658                      Fail
 659                        ("switch character cannot be followed by a blank");
 660                   end if;
 661
 662                   --  The two style project files (-p and -P) cannot be used
 663                   --  together
 664
 665                   if (The_Command = Find or else The_Command = Xref)
 666                     and then Argv (2) = 'p'
 667                   then
 668                      Old_Project_File_Used := True;
 669                      if Project_File /= null then
 670                         Fail ("-P and -p cannot be used together");
 671                      end if;
 672                   end if;
 673
 674                   --  -vPx  Specify verbosity while parsing project files
 675
 676                   if Argv'Length = 4
 677                     and then Argv (Argv'First + 1 .. Argv'First + 2) = "vP"
 678                   then
 679                      case Argv (Argv'Last) is
 680                         when '0' =>
 681                            Current_Verbosity := Prj.Default;
 682                         when '1' =>
 683                            Current_Verbosity := Prj.Medium;
 684                         when '2' =>
 685                            Current_Verbosity := Prj.High;
 686                         when others =>
 687                            Fail ("Invalid switch: ", Argv.all);
 688                      end case;
 689
 690                      Remove_Switch (Arg_Num);
 691
 692                   --  -Pproject_file  Specify project file to be used
 693
 694                   elsif Argv (Argv'First + 1) = 'P' then
 695
 696                      --  Only one -P switch can be used
 697
 698                      if Project_File /= null then
 699                         Fail
 700                           (Argv.all,
 701                            ": second project file forbidden (first is """,
 702                            Project_File.all & """)");
 703
 704                      --  The two style project files (-p and -P) cannot be
 705                      --  used together.
 706
 707                      elsif Old_Project_File_Used then
 708                         Fail ("-p and -P cannot be used together");
 709
 710                      elsif Argv'Length = 2 then
 711
 712                         --  There is space between -P and the project file
 713                         --  name. -P cannot be the last option.
 714
 715                         if Arg_Num = Last_Switches.Last then
 716                            Fail ("project file name missing after -P");
 717
 718                         else
 719                            Remove_Switch (Arg_Num);
 720                            Argv := Last_Switches.Table (Arg_Num);
 721
 722                            --  After -P, there must be a project file name,
 723                            --  not another switch.
 724
 725                            if Argv (Argv'First) = '-' then
 726                               Fail ("project file name missing after -P");
 727
 728                            else
 729                               Project_File := new String'(Argv.all);
 730                            end if;
 731                         end if;
 732
 733                      else
 734                         --  No space between -P and project file name
 735
 736                         Project_File :=
 737                           new String'(Argv (Argv'First + 2 .. Argv'Last));
 738                      end if;
 739
 740                      Remove_Switch (Arg_Num);
 741
 742                   --  -Xexternal=value Specify an external reference to be
 743                   --                   used in project files
 744
 745                   elsif Argv'Length >= 5
 746                     and then Argv (Argv'First + 1) = 'X'
 747                   then
 748                      declare
 749                         Equal_Pos : constant Natural :=
 750                           Index ('=', Argv (Argv'First + 2 .. Argv'Last));
 751                      begin
 752                         if Equal_Pos >= Argv'First + 3 and then
 753                           Equal_Pos /= Argv'Last then
 754                            Add (External_Name =>
 755                                   Argv (Argv'First + 2 .. Equal_Pos - 1),
 756                                 Value => Argv (Equal_Pos + 1 .. Argv'Last));
 757                         else
 758                            Fail
 759                              (Argv.all,
 760                               " is not a valid external assignment.");
 761                         end if;
 762                      end;
 763
 764                      Remove_Switch (Arg_Num);
 765
 766                   else
 767                      Arg_Num := Arg_Num + 1;
 768                   end if;
 769
 770                else
 771                   Arg_Num := Arg_Num + 1;
 772                end if;
 773             end loop;
 774          end Inspect_Switches;
 775       end if;
 776
 777       --  If there is a project file specified, parse it, get the switches
 778       --  for the tool and setup PATH environment variables.
 779
 780       if Project_File /= null then
 781          Prj.Pars.Set_Verbosity (To => Current_Verbosity);
 782
 783          Prj.Pars.Parse
 784            (Project           => Project,
 785             Project_File_Name => Project_File.all,
 786             Packages_To_Check => Packages_To_Check);
 787
 788          if Project = Prj.No_Project then
 789             Fail ("""", Project_File.all, """ processing failed");
 790          end if;
 791
 792          --  Check if a package with the name of the tool is in the project
 793          --  file and if there is one, get the switches, if any, and scan them.
 794
 795          declare
 796             Data : constant Prj.Project_Data :=
 797                      Prj.Projects.Table (Project);
 798
 799             Pkg : constant Prj.Package_Id :=
 800                     Prj.Util.Value_Of
 801                       (Name        => Tool_Package_Name,
 802                        In_Packages => Data.Decl.Packages);
 803
 804             Element : Package_Element;
 805
 806             Default_Switches_Array : Array_Element_Id;
 807
 808             The_Switches : Prj.Variable_Value;
 809             Current      : Prj.String_List_Id;
 810             The_String   : String_Element;
 811
 812          begin
 813             if Pkg /= No_Package then
 814                Element := Packages.Table (Pkg);
 815
 816                --  Packages Gnatls has a single attribute Switches, that is
 817                --  not an associative array.
 818
 819                if The_Command = List then
 820                   The_Switches :=
 821                     Prj.Util.Value_Of
 822                     (Variable_Name => Snames.Name_Switches,
 823                      In_Variables => Element.Decl.Attributes);
 824
 825                --  Packages Binder (for gnatbind), Cross_Reference (for
 826                --  gnatxref), Linker (for gnatlink) Finder (for gnatfind),
 827                --  Pretty_Printer (for gnatpp) and Eliminate (for gnatelim)
 828                --  have an attributed Switches, an associative array, indexed
 829                --  by the name of the file.
 830
 831                --  They also have an attribute Default_Switches, indexed
 832                --  by the name of the programming language.
 833
 834                else
 835                   if The_Switches.Kind = Prj.Undefined then
 836                      Default_Switches_Array :=
 837                        Prj.Util.Value_Of
 838                          (Name => Name_Default_Switches,
 839                           In_Arrays => Packages.Table (Pkg).Decl.Arrays);
 840                      The_Switches := Prj.Util.Value_Of
 841                        (Index => Name_Ada,
 842                         In_Array => Default_Switches_Array);
 843                   end if;
 844                end if;
 845
 846                --  If there are switches specified in the package of the
 847                --  project file corresponding to the tool, scan them.
 848
 849                case The_Switches.Kind is
 850                   when Prj.Undefined =>
 851                      null;
 852
 853                   when Prj.Single =>
 854                      declare
 855                         Switch : constant String :=
 856                                    Get_Name_String (The_Switches.Value);
 857
 858                      begin
 859                         if Switch'Length > 0 then
 860                            First_Switches.Increment_Last;
 861                            First_Switches.Table (First_Switches.Last) :=
 862                              new String'(Switch);
 863                         end if;
 864                      end;
 865
 866                   when Prj.List =>
 867                      Current := The_Switches.Values;
 868                      while Current /= Prj.Nil_String loop
 869                         The_String := String_Elements.Table (Current);
 870
 871                         declare
 872                            Switch : constant String :=
 873                              Get_Name_String (The_String.Value);
 874
 875                         begin
 876                            if Switch'Length > 0 then
 877                               First_Switches.Increment_Last;
 878                               First_Switches.Table (First_Switches.Last) :=
 879                                 new String'(Switch);
 880                            end if;
 881                         end;
 882
 883                         Current := The_String.Next;
 884                      end loop;
 885                end case;
 886             end if;
 887          end;
 888
 889          if The_Command = Bind
 890            or else The_Command = Link
 891            or else The_Command = Elim
 892          then
 893             Change_Dir
 894               (Get_Name_String
 895                  (Projects.Table (Project).Object_Directory));
 896          end if;
 897
 898          --  Set up the env vars for project path files
 899
 900          Prj.Env.Set_Ada_Paths (Project, Including_Libraries => False);
 901
 902          --  For gnatstub, gnatpp and gnatelim, create a configuration pragmas
 903          --  file, if necessary.
 904
 905          if The_Command = Pretty
 906            or else The_Command = Stub
 907            or else The_Command = Elim
 908          then
 909             declare
 910                CP_File : constant Name_Id := Configuration_Pragmas_File;
 911
 912             begin
 913                if CP_File /= No_Name then
 914                   First_Switches.Increment_Last;
 915
 916                   if The_Command = Elim then
 917                      First_Switches.Table (First_Switches.Last)  :=
 918                        new String'("-C" & Get_Name_String (CP_File));
 919
 920                   else
 921                      First_Switches.Table (First_Switches.Last) :=
 922                        new String'("-gnatec=" & Get_Name_String (CP_File));
 923                   end if;
 924                end if;
 925             end;
 926          end if;
 927
 928          if The_Command = Link then
 929
 930             --  Add the default search directories, to be able to find
 931             --  libgnat in call to MLib.Utl.Lib_Directory.
 932
 933             Add_Default_Search_Dirs;
 934
 935             declare
 936                There_Are_Libraries  : Boolean := False;
 937                Path_Option : constant String_Access :=
 938                                MLib.Tgt.Linker_Library_Path_Option;
 939
 940             begin
 941                Library_Paths.Set_Last (0);
 942
 943                --  Check if there are library project files
 944
 945                if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then
 946                   Set_Libraries (Project, There_Are_Libraries);
 947                end if;
 948
 949                --  If there are, add the necessary additional switches
 950
 951                if There_Are_Libraries then
 952
 953                   --  Add -L<lib_dir> -lgnarl -lgnat -Wl,-rpath,<lib_dir>
 954
 955                   Last_Switches.Increment_Last;
 956                   Last_Switches.Table (Last_Switches.Last) :=
 957                     new String'("-L" & MLib.Utl.Lib_Directory);
 958                   Last_Switches.Increment_Last;
 959                   Last_Switches.Table (Last_Switches.Last) :=
 960                     new String'("-lgnarl");
 961                   Last_Switches.Increment_Last;
 962                   Last_Switches.Table (Last_Switches.Last) :=
 963                     new String'("-lgnat");
 964
 965                   --  If Path_Option is not null, create the switch
 966                   --  ("-Wl,-rpath," or equivalent) with all the library dirs
 967                   --  plus the standard GNAT library dir.
 968
 969                   if Path_Option /= null then
 970                      declare
 971                         Option : String_Access;
 972                         Length : Natural := Path_Option'Length;
 973                         Current : Natural;
 974
 975                      begin
 976                         --  First, compute the exact length for the switch
 977
 978                         for Index in
 979                           Library_Paths.First .. Library_Paths.Last
 980                         loop
 981                            --  Add the length of the library dir plus one
 982                            --  for the directory separator.
 983
 984                            Length :=
 985                              Length +
 986                              Library_Paths.Table (Index)'Length + 1;
 987                         end loop;
 988
 989                         --  Finally, add the length of the standard GNAT
 990                         --  library dir.
 991
 992                         Length := Length + MLib.Utl.Lib_Directory'Length;
 993                         Option := new String (1 .. Length);
 994                         Option (1 .. Path_Option'Length) := Path_Option.all;
 995                         Current := Path_Option'Length;
 996
 997                         --  Put each library dir followed by a dir separator
 998
 999                         for Index in
1000                           Library_Paths.First .. Library_Paths.Last
1001                         loop
1002                            Option
1003                              (Current + 1 ..
1004                                 Current +
1005                                 Library_Paths.Table (Index)'Length) :=
1006                              Library_Paths.Table (Index).all;
1007                            Current :=
1008                              Current +
1009                              Library_Paths.Table (Index)'Length + 1;
1010                            Option (Current) := Path_Separator;
1011                         end loop;
1012
1013                         --  Finally put the standard GNAT library dir
1014
1015                         Option
1016                           (Current + 1 ..
1017                              Current + MLib.Utl.Lib_Directory'Length) :=
1018                           MLib.Utl.Lib_Directory;
1019
1020                         --  And add the switch to the last switches
1021
1022                         Last_Switches.Increment_Last;
1023                         Last_Switches.Table (Last_Switches.Last) :=
1024                           Option;
1025                      end;
1026                   end if;
1027                end if;
1028             end;
1029
1030             --  Check if the first ALI file specified can be found, either
1031             --  in the object directory of the main project or in an object
1032             --  directory of a project file extended by the main project.
1033             --  If the ALI file can be found, replace its name with its
1034             --  absolute path.
1035
1036             declare
1037                Skip_Executable : Boolean := False;
1038
1039             begin
1040                Switch_Loop : for J in 1 .. Last_Switches.Last loop
1041
1042                   --  If we have an executable just reset the flag
1043
1044                   if Skip_Executable then
1045                      Skip_Executable := False;
1046
1047                   --  If -o, set flag so that next switch is not processed
1048
1049                   elsif Last_Switches.Table (J).all = "-o" then
1050                      Skip_Executable := True;
1051
1052                   --  Normal case
1053
1054                   else
1055                      declare
1056                         Switch : constant String :=
1057                                    Last_Switches.Table (J).all;
1058
1059                         ALI_File : constant String (1 .. Switch'Length + 4) :=
1060                                      Switch & ".ali";
1061
1062                         Last           : Natural := Switch'Length;
1063                         Test_Existence : Boolean := False;
1064
1065                      begin
1066                         --  Skip real switches
1067
1068                         if Switch'Length /= 0 and then
1069                           Switch (Switch'First) /= '-'
1070                         then
1071                            --  Append ".ali" if file name does not end with it
1072
1073                            if Switch'Length <= 4 or else
1074                              Switch (Switch'Last - 3 .. Switch'Last) /= ".ali"
1075                            then
1076                               Last := ALI_File'Last;
1077                            end if;
1078
1079                            --  If file name includes directory information,
1080                            --  stop if ALI file exists.
1081
1082                            if Is_Absolute_Path (ALI_File (1 .. Last)) then
1083                               Test_Existence := True;
1084
1085                            else
1086                               for K in Switch'Range loop
1087                                  if Switch (K) = '/' or else
1088                                    Switch (K) = Directory_Separator
1089                                  then
1090                                     Test_Existence := True;
1091                                     exit;
1092                                  end if;
1093                               end loop;
1094                            end if;
1095
1096                            if Test_Existence then
1097                               if Is_Regular_File (ALI_File (1 .. Last)) then
1098                                  exit Switch_Loop;
1099                               end if;
1100
1101                            else
1102                               --  Look in the object directories if the ALI
1103                               --  file exists.
1104
1105                               declare
1106                                  Prj : Project_Id := Project;
1107                               begin
1108                                  Project_Loop :
1109                                  loop
1110                                     declare
1111                                        Dir : constant String :=
1112                                          Get_Name_String
1113                                            (Projects.Table (Prj).
1114                                               Object_Directory);
1115                                     begin
1116                                        if Is_Regular_File
1117                                          (Dir & Directory_Separator &
1118                                           ALI_File (1 .. Last))
1119                                        then
1120                                           --  We have found the correct
1121                                           --  project, so we replace the file
1122                                           --  with the absolute path.
1123
1124                                           Last_Switches.Table (J) :=
1125                                             new String'
1126                                               (Dir & Directory_Separator &
1127                                                ALI_File (1 .. Last));
1128
1129                                           --  And we are done
1130
1131                                           exit Switch_Loop;
1132                                        end if;
1133                                     end;
1134
1135                                     --  Go to the project being extended,
1136                                     --  if any.
1137
1138                                     Prj := Projects.Table (Prj).Extends;
1139                                     exit Project_Loop when Prj = No_Project;
1140                                  end loop Project_Loop;
1141                               end;
1142                            end if;
1143                         end if;
1144                      end;
1145                   end if;
1146                end loop Switch_Loop;
1147             end;
1148
1149             --  If a relative path output file has been specified, we add
1150             --  the exec directory.
1151
1152             declare
1153                Look_For_Executable : Boolean := True;
1154
1155             begin
1156
1157                for J in reverse 1 .. Last_Switches.Last - 1 loop
1158                   if Last_Switches.Table (J).all = "-o" then
1159                      Check_Relative_Executable
1160                        (Name => Last_Switches.Table (J + 1));
1161                      Look_For_Executable := False;
1162                      exit;
1163                   end if;
1164                end loop;
1165
1166                if Look_For_Executable then
1167                   for J in reverse 1 .. First_Switches.Last - 1 loop
1168                      if First_Switches.Table (J).all = "-o" then
1169                         Look_For_Executable := False;
1170                         Check_Relative_Executable
1171                           (Name => First_Switches.Table (J + 1));
1172                         exit;
1173                      end if;
1174                   end loop;
1175                end if;
1176
1177                --  If no executable is specified, then find the name
1178                --  of the first ALI file on the command line and issue
1179                --  a -o switch with the absolute path of the executable
1180                --  in the exec directory.
1181
1182                if Look_For_Executable then
1183                   for J in 1 .. Last_Switches.Last loop
1184                      declare
1185                         Arg  : constant String_Access :=
1186                                  Last_Switches.Table (J);
1187                         Last : Natural := 0;
1188
1189                      begin
1190                         if Arg'Length /= 0 and then Arg (Arg'First) /= '-' then
1191                            if Arg'Length > 4
1192                              and then Arg (Arg'Last - 3 .. Arg'Last) = ".ali"
1193                            then
1194                               Last := Arg'Last - 4;
1195
1196                            elsif Is_Regular_File (Arg.all & ".ali") then
1197                               Last := Arg'Last;
1198                            end if;
1199
1200                            if Last /= 0 then
1201                               declare
1202                                  Executable_Name : constant String :=
1203                                    Base_Name (Arg (Arg'First .. Last));
1204                               begin
1205                                  Last_Switches.Increment_Last;
1206                                  Last_Switches.Table (Last_Switches.Last) :=
1207                                    new String'("-o");
1208                                  Get_Name_String
1209                                    (Projects.Table (Project).Exec_Directory);
1210                                  Last_Switches.Increment_Last;
1211                                  Last_Switches.Table (Last_Switches.Last) :=
1212                                     new String'(Name_Buffer (1 .. Name_Len) &
1213                                                   Directory_Separator &
1214                                                   Executable_Name &
1215                                                   Get_Executable_Suffix.all);
1216                                  exit;
1217                               end;
1218                            end if;
1219                         end if;
1220                      end;
1221                   end loop;
1222                end if;
1223             end;
1224          end if;
1225
1226          if The_Command = Link or The_Command = Bind then
1227
1228             --  For files that are specified as relative paths with directory
1229             --  information, we convert them to absolute paths, with parent
1230             --  being the current working directory if specified on the command
1231             --  line and the project directory if specified in the project
1232             --  file. This is what gnatmake is doing for linker and binder
1233             --  arguments.
1234
1235             for J in 1 .. Last_Switches.Last loop
1236                Test_If_Relative_Path
1237                  (Last_Switches.Table (J), Current_Work_Dir);
1238             end loop;
1239
1240             Get_Name_String (Projects.Table (Project).Directory);
1241
1242             declare
1243                Project_Dir : constant String := Name_Buffer (1 .. Name_Len);
1244
1245             begin
1246                for J in 1 .. First_Switches.Last loop
1247                   Test_If_Relative_Path
1248                     (First_Switches.Table (J), Project_Dir);
1249                end loop;
1250             end;
1251
1252          elsif The_Command = Stub then
1253             declare
1254                Data : constant Prj.Project_Data :=
1255                         Prj.Projects.Table (Project);
1256                File_Index : Integer := 0;
1257                Dir_Index  : Integer := 0;
1258                Last       : constant Integer := Last_Switches.Last;
1259
1260             begin
1261                for Index in 1 .. Last loop
1262                   if Last_Switches.Table (Index)
1263                     (Last_Switches.Table (Index)'First) /= '-'
1264                   then
1265                      File_Index := Index;
1266                      exit;
1267                   end if;
1268                end loop;
1269
1270                --  If the naming scheme of the project file is not standard,
1271                --  and if the file name ends with the spec suffix, then
1272                --  indicate to gnatstub the name of the body file with
1273                --  a -o switch.
1274
1275                if Data.Naming.Current_Spec_Suffix /=
1276                  Prj.Default_Ada_Spec_Suffix
1277                then
1278                   if File_Index /= 0 then
1279                      declare
1280                         Spec : constant String :=
1281                           Base_Name (Last_Switches.Table (File_Index).all);
1282                         Last : Natural := Spec'Last;
1283
1284                      begin
1285                         Get_Name_String (Data.Naming.Current_Spec_Suffix);
1286
1287                         if Spec'Length > Name_Len
1288                           and then Spec (Last - Name_Len + 1 .. Last) =
1289                           Name_Buffer (1 .. Name_Len)
1290                         then
1291                            Last := Last - Name_Len;
1292                            Get_Name_String (Data.Naming.Current_Body_Suffix);
1293                            Last_Switches.Increment_Last;
1294                            Last_Switches.Table (Last_Switches.Last) :=
1295                              new String'("-o");
1296                            Last_Switches.Increment_Last;
1297                            Last_Switches.Table (Last_Switches.Last) :=
1298                              new String'(Spec (Spec'First .. Last) &
1299                                            Name_Buffer (1 .. Name_Len));
1300                         end if;
1301                      end;
1302                   end if;
1303                end if;
1304
1305                --  Add the directory of the spec as the destination directory
1306                --  of the body, if there is no destination directory already
1307                --  specified.
1308
1309                if File_Index /= 0 then
1310                   for Index in File_Index + 1 .. Last loop
1311                      if Last_Switches.Table (Index)
1312                        (Last_Switches.Table (Index)'First) /= '-'
1313                      then
1314                         Dir_Index := Index;
1315                         exit;
1316                      end if;
1317                   end loop;
1318
1319                   if Dir_Index = 0 then
1320                      Last_Switches.Increment_Last;
1321                      Last_Switches.Table (Last_Switches.Last) :=
1322                        new String'
1323                              (Dir_Name (Last_Switches.Table (File_Index).all));
1324                   end if;
1325                end if;
1326             end;
1327          end if;
1328       end if;
1329
1330       --  Gather all the arguments and invoke the executable
1331
1332       declare
1333          The_Args : Argument_List
1334            (1 .. First_Switches.Last + Last_Switches.Last);
1335          Arg_Num : Natural := 0;
1336       begin
1337          for J in 1 .. First_Switches.Last loop
1338             Arg_Num := Arg_Num + 1;
1339             The_Args (Arg_Num) := First_Switches.Table (J);
1340          end loop;
1341
1342          for J in 1 .. Last_Switches.Last loop
1343             Arg_Num := Arg_Num + 1;
1344             The_Args (Arg_Num) := Last_Switches.Table (J);
1345          end loop;
1346
1347          --  If Display_Command is on, only display the generated command
1348
1349          if Display_Command then
1350             Put (Standard_Error, "generated command -->");
1351             Put (Standard_Error, Exec_Path.all);
1352
1353             for Arg in The_Args'Range loop
1354                Put (Standard_Error, " ");
1355                Put (Standard_Error, The_Args (Arg).all);
1356             end loop;
1357
1358             Put (Standard_Error, "<--");
1359             New_Line (Standard_Error);
1360             raise Normal_Exit;
1361          end if;
1362
1363          if Opt.Verbose_Mode then
1364             Output.Write_Str (Exec_Path.all);
1365
1366             for Arg in The_Args'Range loop
1367                Output.Write_Char (' ');
1368                Output.Write_Str (The_Args (Arg).all);
1369             end loop;
1370
1371             Output.Write_Eol;
1372          end if;
1373
1374          My_Exit_Status :=
1375            Exit_Status (Spawn (Exec_Path.all, The_Args));
1376          raise Normal_Exit;
1377       end;
1378    end;
1379
1380 exception
1381    when Error_Exit =>
1382       Prj.Env.Delete_All_Path_Files;
1383       Delete_Temp_Config_Files;
1384       Set_Exit_Status (Failure);
1385
1386    when Normal_Exit =>
1387       Prj.Env.Delete_All_Path_Files;
1388       Delete_Temp_Config_Files;
1389
1390       --  Since GNATCmd is normally called from DCL (the VMS shell),
1391       --  it must return an understandable VMS exit status. However
1392       --  the exit status returned *to* GNATCmd is a Posix style code,
1393       --  so we test it and return just a simple success or failure on VMS.
1394
1395       if Hostparm.OpenVMS and then My_Exit_Status /= Success then
1396          Set_Exit_Status (Failure);
1397       else
1398          Set_Exit_Status (My_Exit_Status);
1399       end if;
1400 end GNATCmd;