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