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-2009, 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 3,  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 COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
  27
  28 with Csets;
  29 with Makeutl;
  30 with MLib.Tgt; use MLib.Tgt;
  31 with MLib.Utl;
  32 with MLib.Fil;
  33 with Namet;    use Namet;
  34 with Opt;      use Opt;
  35 with Osint;    use Osint;
  36 with Output;
  37 with Prj;      use Prj;
  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 Targparm;
  46 with Tempdir;
  47 with Types;    use Types;
  48 with Hostparm; use Hostparm;
  49 --  Used to determine if we are in VMS or not for error message purposes
  50
  51 with Ada.Characters.Handling; use Ada.Characters.Handling;
  52 with Ada.Command_Line;        use Ada.Command_Line;
  53 with Ada.Text_IO;             use Ada.Text_IO;
  54
  55 with GNAT.OS_Lib;             use GNAT.OS_Lib;
  56
  57 with VMS_Conv;                use VMS_Conv;
  58
  59 procedure GNATCmd is
  60    Project_Tree      : constant Project_Tree_Ref := new Project_Tree_Data;
  61    Project_File      : String_Access;
  62    Project           : Prj.Project_Id;
  63    Current_Verbosity : Prj.Verbosity := Prj.Default;
  64    Tool_Package_Name : Name_Id       := No_Name;
  65
  66    B_Start : String_Ptr    := new String'("b~");
  67    --  Prefix of binder generated file, changed to b__ for VMS
  68
  69    Old_Project_File_Used : Boolean := False;
  70    --  This flag indicates a switch -p (for gnatxref and gnatfind) for
  71    --  an old fashioned project file. -p cannot be used in conjunction
  72    --  with -P.
  73
  74    Temp_File_Name : Path_Name_Type := No_Path;
  75    --  The name of the temporary text file to put a list of source/object
  76    --  files to pass to a tool.
  77
  78    ASIS_Main : String_Access := null;
  79    --  Main for commands Check, Metric and Pretty, when -U is used
  80
  81    package First_Switches is new Table.Table
  82      (Table_Component_Type => String_Access,
  83       Table_Index_Type     => Integer,
  84       Table_Low_Bound      => 1,
  85       Table_Initial        => 20,
  86       Table_Increment      => 100,
  87       Table_Name           => "Gnatcmd.First_Switches");
  88    --  A table to keep the switches from the project file
  89
  90    package Carg_Switches is new Table.Table
  91      (Table_Component_Type => String_Access,
  92       Table_Index_Type     => Integer,
  93       Table_Low_Bound      => 1,
  94       Table_Initial        => 20,
  95       Table_Increment      => 100,
  96       Table_Name           => "Gnatcmd.Carg_Switches");
  97    --  A table to keep the switches following -cargs for ASIS tools
  98
  99    package Rules_Switches is new Table.Table
 100      (Table_Component_Type => String_Access,
 101       Table_Index_Type     => Integer,
 102       Table_Low_Bound      => 1,
 103       Table_Initial        => 20,
 104       Table_Increment      => 100,
 105       Table_Name           => "Gnatcmd.Rules_Switches");
 106    --  A table to keep the switches following -rules for gnatcheck
 107
 108    package Library_Paths is new Table.Table (
 109      Table_Component_Type => String_Access,
 110      Table_Index_Type     => Integer,
 111      Table_Low_Bound      => 1,
 112      Table_Initial        => 20,
 113      Table_Increment      => 100,
 114      Table_Name           => "Make.Library_Path");
 115
 116    --  Packages of project files to pass to Prj.Pars.Parse, depending on the
 117    --  tool. We allocate objects because we cannot declare aliased objects
 118    --  as we are in a procedure, not a library level package.
 119
 120    subtype SA is String_Access;
 121
 122    Naming_String      : constant SA := new String'("naming");
 123    Binder_String      : constant SA := new String'("binder");
 124    Compiler_String    : constant SA := new String'("compiler");
 125    Check_String       : constant SA := new String'("check");
 126    Synchronize_String : constant SA := new String'("synchronize");
 127    Eliminate_String   : constant SA := new String'("eliminate");
 128    Finder_String      : constant SA := new String'("finder");
 129    Linker_String      : constant SA := new String'("linker");
 130    Gnatls_String      : constant SA := new String'("gnatls");
 131    Pretty_String      : constant SA := new String'("pretty_printer");
 132    Stack_String       : constant SA := new String'("stack");
 133    Gnatstub_String    : constant SA := new String'("gnatstub");
 134    Metric_String      : constant SA := new String'("metrics");
 135    Xref_String        : constant SA := new String'("cross_reference");
 136
 137    Packages_To_Check_By_Binder   : constant String_List_Access :=
 138      new String_List'((Naming_String, Binder_String));
 139
 140    Packages_To_Check_By_Check : constant String_List_Access :=
 141      new String_List'((Naming_String, Check_String, Compiler_String));
 142
 143    Packages_To_Check_By_Sync : constant String_List_Access :=
 144      new String_List'((Naming_String, Synchronize_String, Compiler_String));
 145
 146    Packages_To_Check_By_Eliminate : constant String_List_Access :=
 147      new String_List'((Naming_String, Eliminate_String, Compiler_String));
 148
 149    Packages_To_Check_By_Finder    : constant String_List_Access :=
 150      new String_List'((Naming_String, Finder_String));
 151
 152    Packages_To_Check_By_Linker    : constant String_List_Access :=
 153      new String_List'((Naming_String, Linker_String));
 154
 155    Packages_To_Check_By_Gnatls    : constant String_List_Access :=
 156      new String_List'((Naming_String, Gnatls_String));
 157
 158    Packages_To_Check_By_Pretty    : constant String_List_Access :=
 159      new String_List'((Naming_String, Pretty_String, Compiler_String));
 160
 161    Packages_To_Check_By_Stack     : constant String_List_Access :=
 162      new String_List'((Naming_String, Stack_String));
 163
 164    Packages_To_Check_By_Gnatstub  : constant String_List_Access :=
 165      new String_List'((Naming_String, Gnatstub_String, Compiler_String));
 166
 167    Packages_To_Check_By_Metric  : constant String_List_Access :=
 168      new String_List'((Naming_String, Metric_String, Compiler_String));
 169
 170    Packages_To_Check_By_Xref      : constant String_List_Access :=
 171      new String_List'((Naming_String, Xref_String));
 172
 173    Packages_To_Check : String_List_Access := Prj.All_Packages;
 174
 175    ----------------------------------
 176    -- Declarations for GNATCMD use --
 177    ----------------------------------
 178
 179    The_Command : Command_Type;
 180    --  The command specified in the invocation of the GNAT driver
 181
 182    Command_Arg : Positive := 1;
 183    --  The index of the command in the arguments of the GNAT driver
 184
 185    My_Exit_Status : Exit_Status := Success;
 186    --  The exit status of the spawned tool. Used to set the correct VMS
 187    --  exit status.
 188
 189    Current_Work_Dir : constant String := Get_Current_Dir;
 190    --  The path of the working directory
 191
 192    All_Projects : Boolean := False;
 193    --  Flag used for GNAT CHECK, GNAT PRETTY, GNAT METRIC, and GNAT STACK to
 194    --  indicate that the underlying tool (gnatcheck, gnatpp or gnatmetric)
 195    --  should be invoked for all sources of all projects.
 196
 197    -----------------------
 198    -- Local Subprograms --
 199    -----------------------
 200
 201    procedure Add_To_Carg_Switches (Switch : String_Access);
 202    --  Add a switch to the Carg_Switches table. If it is the first one, put the
 203    --  switch "-cargs" at the beginning of the table.
 204
 205    procedure Add_To_Rules_Switches (Switch : String_Access);
 206    --  Add a switch to the Rules_Switches table. If it is the first one, put
 207    --  the switch "-crules" at the beginning of the table.
 208
 209    procedure Check_Files;
 210    --  For GNAT LIST, GNAT PRETTY, GNAT METRIC, and GNAT STACK, check if a
 211    --  project file is specified, without any file arguments. If it is the
 212    --  case, invoke the GNAT tool with the proper list of files, derived from
 213    --  the sources of the project.
 214
 215    function Check_Project
 216      (Project      : Project_Id;
 217       Root_Project : Project_Id) return Boolean;
 218    --  Returns True if Project = Root_Project or if we want to consider all
 219    --  sources of all projects. For GNAT METRIC, also returns True if Project
 220    --  is extended by Root_Project.
 221
 222    procedure Check_Relative_Executable (Name : in out String_Access);
 223    --  Check if an executable is specified as a relative path. If it is, and
 224    --  the path contains directory information, fail. Otherwise, prepend the
 225    --  exec directory. This procedure is only used for GNAT LINK when a project
 226    --  file is specified.
 227
 228    function Configuration_Pragmas_File return Path_Name_Type;
 229    --  Return an argument, if there is a configuration pragmas file to be
 230    --  specified for Project, otherwise return No_Name. Used for gnatstub (GNAT
 231    --  STUB), gnatpp (GNAT PRETTY), gnatelim (GNAT ELIM), and gnatmetric (GNAT
 232    --  METRIC).
 233
 234    procedure Delete_Temp_Config_Files;
 235    --  Delete all temporary config files. The caller is responsible for
 236    --  ensuring that Keep_Temporary_Files is False.
 237
 238    procedure Get_Closure;
 239    --  Get the sources in the closure of the ASIS_Main and add them to the
 240    --  list of arguments.
 241
 242    function Index (Char : Character; Str : String) return Natural;
 243    --  Returns first occurrence of Char in Str, returns 0 if Char not in Str
 244
 245    procedure Non_VMS_Usage;
 246    --  Display usage for platforms other than VMS
 247
 248    procedure Process_Link;
 249    --  Process GNAT LINK, when there is a project file specified
 250
 251    procedure Set_Library_For
 252      (Project           : Project_Id;
 253       Libraries_Present : in out Boolean);
 254    --  If Project is a library project, add the correct -L and -l switches to
 255    --  the linker invocation.
 256
 257    procedure Set_Libraries is
 258       new For_Every_Project_Imported (Boolean, Set_Library_For);
 259    --  Add the -L and -l switches to the linker for all of the library
 260    --  projects.
 261
 262    procedure Test_If_Relative_Path
 263      (Switch : in out String_Access;
 264       Parent : String);
 265    --  Test if Switch is a relative search path switch. If it is and it
 266    --  includes directory information, prepend the path with Parent. This
 267    --  subprogram is only called when using project files.
 268
 269    --------------------------
 270    -- Add_To_Carg_Switches --
 271    --------------------------
 272
 273    procedure Add_To_Carg_Switches (Switch : String_Access) is
 274    begin
 275       --  If the Carg_Switches table is empty, put "-cargs" at the beginning
 276
 277       if Carg_Switches.Last = 0 then
 278          Carg_Switches.Increment_Last;
 279          Carg_Switches.Table (Carg_Switches.Last) := new String'("-cargs");
 280       end if;
 281
 282       Carg_Switches.Increment_Last;
 283       Carg_Switches.Table (Carg_Switches.Last) := Switch;
 284    end Add_To_Carg_Switches;
 285
 286    ---------------------------
 287    -- Add_To_Rules_Switches --
 288    ---------------------------
 289
 290    procedure Add_To_Rules_Switches (Switch : String_Access) is
 291    begin
 292       --  If the Rules_Switches table is empty, put "-rules" at the beginning
 293
 294       if Rules_Switches.Last = 0 then
 295          Rules_Switches.Increment_Last;
 296          Rules_Switches.Table (Rules_Switches.Last) := new String'("-rules");
 297       end if;
 298
 299       Rules_Switches.Increment_Last;
 300       Rules_Switches.Table (Rules_Switches.Last) := Switch;
 301    end Add_To_Rules_Switches;
 302
 303    -----------------
 304    -- Check_Files --
 305    -----------------
 306
 307    procedure Check_Files is
 308       Add_Sources : Boolean := True;
 309       Unit        : Prj.Unit_Index;
 310       Subunit     : Boolean := False;
 311       FD          : File_Descriptor := Invalid_FD;
 312       Status      : Integer;
 313       Success     : Boolean;
 314
 315    begin
 316       --  Check if there is at least one argument that is not a switch
 317
 318       for Index in 1 .. Last_Switches.Last loop
 319          if Last_Switches.Table (Index) (1) /= '-' then
 320             Add_Sources := False;
 321             exit;
 322          end if;
 323       end loop;
 324
 325       --  If all arguments were switches, add the path names of all the sources
 326       --  of the main project.
 327
 328       if Add_Sources then
 329
 330          --  For gnatcheck, gnatpp and gnatmetric , create a temporary file and
 331          --  put the list of sources in it.
 332
 333          if The_Command = Check  or else
 334             The_Command = Pretty or else
 335             The_Command = Metric
 336          then
 337             Tempdir.Create_Temp_File (FD, Temp_File_Name);
 338             Last_Switches.Increment_Last;
 339             Last_Switches.Table (Last_Switches.Last) :=
 340               new String'("-files=" & Get_Name_String (Temp_File_Name));
 341          end if;
 342
 343          declare
 344             Proj : Project_List;
 345
 346          begin
 347             --  Gnatstack needs to add the .ci file for the binder generated
 348             --  files corresponding to all of the library projects and main
 349             --  units belonging to the application.
 350
 351             if The_Command = Stack then
 352                Proj := Project_Tree.Projects;
 353                while Proj /= null loop
 354                   if Check_Project (Proj.Project, Project) then
 355                      declare
 356                         Main : String_List_Id;
 357                         File : String_Access;
 358
 359                      begin
 360                         --  Include binder generated files for main programs
 361
 362                         Main := Proj.Project.Mains;
 363                         while Main /= Nil_String loop
 364                            File :=
 365                              new String'
 366                                (Get_Name_String
 367                                     (Proj.Project.Object_Directory.Name)     &
 368                                 Directory_Separator                          &
 369                                 B_Start.all                                  &
 370                                 MLib.Fil.Ext_To
 371                                   (Get_Name_String
 372                                      (Project_Tree.String_Elements.Table
 373                                         (Main).Value),
 374                                    "ci"));
 375
 376                            if Is_Regular_File (File.all) then
 377                               Last_Switches.Increment_Last;
 378                               Last_Switches.Table (Last_Switches.Last) := File;
 379                            end if;
 380
 381                            Main :=
 382                              Project_Tree.String_Elements.Table (Main).Next;
 383                         end loop;
 384
 385                         if Proj.Project.Library then
 386
 387                            --  Include the .ci file for the binder generated
 388                            --  files that contains the initialization and
 389                            --  finalization of the library.
 390
 391                            File :=
 392                              new String'
 393                                (Get_Name_String
 394                                     (Proj.Project.Object_Directory.Name)     &
 395                                 Directory_Separator                          &
 396                                 B_Start.all                                  &
 397                                 Get_Name_String (Proj.Project.Library_Name)  &
 398                                 ".ci");
 399
 400                            if Is_Regular_File (File.all) then
 401                               Last_Switches.Increment_Last;
 402                               Last_Switches.Table (Last_Switches.Last) := File;
 403                            end if;
 404                         end if;
 405                      end;
 406                   end if;
 407
 408                   Proj := Proj.Next;
 409                end loop;
 410             end if;
 411
 412             Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
 413             while Unit /= No_Unit_Index loop
 414
 415                --  For gnatls, we only need to put the library units, body or
 416                --  spec, but not the subunits.
 417
 418                if The_Command = List then
 419                   if Unit.File_Names (Impl) /= null
 420                     and then Unit.File_Names (Impl).Path.Name /= Slash
 421                   then
 422                      --  There is a body, check if it is for this project
 423
 424                      if All_Projects or else
 425                         Unit.File_Names (Impl).Project = Project
 426                      then
 427                         Subunit := False;
 428
 429                         if Unit.File_Names (Spec) = null
 430                           or else Unit.File_Names (Spec).Path.Name = Slash
 431                         then
 432                            --  We have a body with no spec: we need to check if
 433                            --  this is a subunit, because gnatls will complain
 434                            --  about subunits.
 435
 436                            declare
 437                               Src_Ind : constant Source_File_Index :=
 438                                           Sinput.P.Load_Project_File
 439                                             (Get_Name_String
 440                                               (Unit.File_Names
 441                                                 (Impl).Path.Name));
 442                            begin
 443                               Subunit :=
 444                                 Sinput.P.Source_File_Is_Subunit (Src_Ind);
 445                            end;
 446                         end if;
 447
 448                         if not Subunit then
 449                            Last_Switches.Increment_Last;
 450                            Last_Switches.Table (Last_Switches.Last) :=
 451                              new String'
 452                                (Get_Name_String
 453                                     (Unit.File_Names
 454                                          (Impl).Display_File));
 455                         end if;
 456                      end if;
 457
 458                   elsif Unit.File_Names (Spec) /= null
 459                     and then Unit.File_Names (Spec).Path.Name /= Slash
 460                   then
 461                      --  We have a spec with no body. Check if it is for this
 462                      --  project.
 463
 464                      if All_Projects or else
 465                         Unit.File_Names (Spec).Project = Project
 466                      then
 467                         Last_Switches.Increment_Last;
 468                         Last_Switches.Table (Last_Switches.Last) :=
 469                           new String'(Get_Name_String
 470                                        (Unit.File_Names (Spec).Display_File));
 471                      end if;
 472                   end if;
 473
 474                --  For gnatstack, we put the .ci files corresponding to the
 475                --  different units, including the binder generated files. We
 476                --  only need to do that for the library units, body or spec,
 477                --  but not the subunits.
 478
 479                elsif The_Command = Stack then
 480                   if Unit.File_Names (Impl) /= null
 481                     and then Unit.File_Names (Impl).Path.Name /= Slash
 482                   then
 483                      --  There is a body. Check if .ci files for this project
 484                      --  must be added.
 485
 486                      if Check_Project
 487                           (Unit.File_Names (Impl).Project, Project)
 488                      then
 489                         Subunit := False;
 490
 491                         if Unit.File_Names (Spec) = null
 492                           or else Unit.File_Names (Spec).Path.Name = Slash
 493                         then
 494                            --  We have a body with no spec: we need to check
 495                            --  if this is a subunit, because .ci files are not
 496                            --  generated for subunits.
 497
 498                            declare
 499                               Src_Ind : constant Source_File_Index :=
 500                                           Sinput.P.Load_Project_File
 501                                             (Get_Name_String
 502                                               (Unit.File_Names
 503                                                 (Impl).Path.Name));
 504                            begin
 505                               Subunit :=
 506                                 Sinput.P.Source_File_Is_Subunit (Src_Ind);
 507                            end;
 508                         end if;
 509
 510                         if not Subunit then
 511                            Last_Switches.Increment_Last;
 512                            Last_Switches.Table (Last_Switches.Last) :=
 513                              new String'
 514                                (Get_Name_String
 515                                  (Unit.File_Names
 516                                    (Impl).Project. Object_Directory.Name)  &
 517                                 Directory_Separator                        &
 518                                 MLib.Fil.Ext_To
 519                                   (Get_Name_String
 520                                      (Unit.File_Names (Impl).Display_File),
 521                                    "ci"));
 522                         end if;
 523                      end if;
 524
 525                   elsif Unit.File_Names (Spec) /= null
 526                     and then Unit.File_Names (Spec).Path.Name /= Slash
 527                   then
 528                      --  Spec with no body, check if it is for this project
 529
 530                      if Check_Project
 531                           (Unit.File_Names (Spec).Project, Project)
 532                      then
 533                         Last_Switches.Increment_Last;
 534                         Last_Switches.Table (Last_Switches.Last) :=
 535                           new String'
 536                             (Get_Name_String
 537                               (Unit.File_Names
 538                                 (Spec).Project. Object_Directory.Name)     &
 539                              Dir_Separator                                 &
 540                              MLib.Fil.Ext_To
 541                                (Get_Name_String (Unit.File_Names (Spec).File),
 542                                 "ci"));
 543                      end if;
 544                   end if;
 545
 546                else
 547                   --  For gnatcheck, gnatsync, gnatpp and gnatmetric, put all
 548                   --  sources of the project, or of all projects if -U was
 549                   --  specified.
 550
 551                   for Kind in Spec_Or_Body loop
 552                      if Unit.File_Names (Kind) /= null
 553                        and then Check_Project
 554                                   (Unit.File_Names (Kind).Project, Project)
 555                        and then Unit.File_Names (Kind).Path.Name /= Slash
 556                      then
 557                         Get_Name_String
 558                           (Unit.File_Names (Kind).Path.Display_Name);
 559
 560                         if FD /= Invalid_FD then
 561                            Name_Len := Name_Len + 1;
 562                            Name_Buffer (Name_Len) := ASCII.LF;
 563                            Status :=
 564                              Write (FD, Name_Buffer (1)'Address, Name_Len);
 565
 566                            if Status /= Name_Len then
 567                               Osint.Fail ("disk full");
 568                            end if;
 569
 570                         else
 571                            Last_Switches.Increment_Last;
 572                            Last_Switches.Table (Last_Switches.Last) :=
 573                              new String'(Get_Name_String
 574                                           (Unit.File_Names
 575                                             (Kind).Path.Display_Name));
 576                         end if;
 577                      end if;
 578                   end loop;
 579                end if;
 580
 581                Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
 582             end loop;
 583          end;
 584
 585          if FD /= Invalid_FD then
 586             Close (FD, Success);
 587
 588             if not Success then
 589                Osint.Fail ("disk full");
 590             end if;
 591          end if;
 592       end if;
 593    end Check_Files;
 594
 595    -------------------
 596    -- Check_Project --
 597    -------------------
 598
 599    function Check_Project
 600      (Project      : Project_Id;
 601       Root_Project : Project_Id) return Boolean
 602    is
 603       Proj : Project_Id;
 604
 605    begin
 606       if Project = No_Project then
 607          return False;
 608
 609       elsif All_Projects or Project = Root_Project then
 610          return True;
 611
 612       elsif The_Command = Metric then
 613          Proj := Root_Project;
 614          while Proj.Extends /= No_Project loop
 615             if Project = Proj.Extends then
 616                return True;
 617             end if;
 618
 619             Proj := Proj.Extends;
 620          end loop;
 621       end if;
 622
 623       return False;
 624    end Check_Project;
 625
 626    -------------------------------
 627    -- Check_Relative_Executable --
 628    -------------------------------
 629
 630    procedure Check_Relative_Executable (Name : in out String_Access) is
 631       Exec_File_Name : constant String := Name.all;
 632
 633    begin
 634       if not Is_Absolute_Path (Exec_File_Name) then
 635          for Index in Exec_File_Name'Range loop
 636             if Exec_File_Name (Index) = Directory_Separator then
 637                Fail ("relative executable (""" &
 638                        Exec_File_Name &
 639                        """) with directory part not allowed " &
 640                        "when using project files");
 641             end if;
 642          end loop;
 643
 644          Get_Name_String (Project.Exec_Directory.Name);
 645
 646          if Name_Buffer (Name_Len) /= Directory_Separator then
 647             Name_Len := Name_Len + 1;
 648             Name_Buffer (Name_Len) := Directory_Separator;
 649          end if;
 650
 651          Name_Buffer (Name_Len + 1 ..
 652                         Name_Len + Exec_File_Name'Length) :=
 653            Exec_File_Name;
 654          Name_Len := Name_Len + Exec_File_Name'Length;
 655          Name := new String'(Name_Buffer (1 .. Name_Len));
 656       end if;
 657    end Check_Relative_Executable;
 658
 659    --------------------------------
 660    -- Configuration_Pragmas_File --
 661    --------------------------------
 662
 663    function Configuration_Pragmas_File return Path_Name_Type is
 664    begin
 665       Prj.Env.Create_Config_Pragmas_File
 666         (Project, Project, Project_Tree, Include_Config_Files => False);
 667       return Project.Config_File_Name;
 668    end Configuration_Pragmas_File;
 669
 670    ------------------------------
 671    -- Delete_Temp_Config_Files --
 672    ------------------------------
 673
 674    procedure Delete_Temp_Config_Files is
 675       Success : Boolean;
 676       Proj    : Project_List;
 677       pragma Warnings (Off, Success);
 678
 679    begin
 680       --  This should only be called if Keep_Temporary_Files is False
 681
 682       pragma Assert (not Keep_Temporary_Files);
 683
 684       if Project /= No_Project then
 685          Proj := Project_Tree.Projects;
 686          while Proj /= null loop
 687             if Proj.Project.Config_File_Temp then
 688                if Verbose_Mode then
 689                   Output.Write_Str ("Deleting temp configuration file """);
 690                   Output.Write_Str
 691                     (Get_Name_String (Proj.Project.Config_File_Name));
 692                   Output.Write_Line ("""");
 693                end if;
 694
 695                Delete_File
 696                  (Name    => Get_Name_String (Proj.Project.Config_File_Name),
 697                   Success => Success);
 698             end if;
 699
 700             Proj := Proj.Next;
 701          end loop;
 702       end if;
 703
 704       --  If a temporary text file that contains a list of files for a tool
 705       --  has been created, delete this temporary file.
 706
 707       if Temp_File_Name /= No_Path then
 708          Delete_File (Get_Name_String (Temp_File_Name), Success);
 709       end if;
 710    end Delete_Temp_Config_Files;
 711
 712    -----------------
 713    -- Get_Closure --
 714    -----------------
 715
 716    procedure Get_Closure is
 717       Args : constant Argument_List :=
 718                (1 => new String'("-q"),
 719                 2 => new String'("-b"),
 720                 3 => new String'("-P"),
 721                 4 => Project_File,
 722                 5 => ASIS_Main,
 723                 6 => new String'("-bargs"),
 724                 7 => new String'("-R"),
 725                 8 => new String'("-Z"));
 726       --  Arguments for the invocation of gnatmake which are added to the
 727       --  Last_Arguments list by this procedure.
 728
 729       FD : File_Descriptor;
 730       --  File descriptor for the temp file that will get the output of the
 731       --  invocation of gnatmake.
 732
 733       Name : Path_Name_Type;
 734       --  Path of the file FD
 735
 736       GN_Name : constant String := Program_Name ("gnatmake", "gnat").all;
 737       --  Name for gnatmake
 738
 739       GN_Path : constant String_Access := Locate_Exec_On_Path (GN_Name);
 740       --  Path of gnatmake
 741
 742       Return_Code : Integer;
 743
 744       Unused : Boolean;
 745       pragma Warnings (Off, Unused);
 746
 747       File : Ada.Text_IO.File_Type;
 748       Line : String (1 .. 250);
 749       Last : Natural;
 750       --  Used to read file if there is an error, it is good enough to display
 751       --  just 250 characters if the first line of the file is very long.
 752
 753       Unit  : Unit_Index;
 754       Path  : Path_Name_Type;
 755
 756    begin
 757       if GN_Path = null then
 758          Put_Line (Standard_Error, "could not locate " & GN_Name);
 759          raise Error_Exit;
 760       end if;
 761
 762       --  Create the temp file
 763
 764       Tempdir.Create_Temp_File (FD, Name);
 765
 766       --  And close it, because on VMS Spawn with a file descriptor created
 767       --  with Create_Temp_File does not redirect output.
 768
 769       Close (FD);
 770
 771       --  Spawn "gnatmake -q -b -P <project> <main> -bargs -R -Z"
 772
 773       Spawn
 774         (Program_Name => GN_Path.all,
 775          Args         => Args,
 776          Output_File  => Get_Name_String (Name),
 777          Success      => Unused,
 778          Return_Code  => Return_Code,
 779          Err_To_Out   => True);
 780
 781       Close (FD);
 782
 783       --  Read the output of the invocation of gnatmake
 784
 785       Open (File, In_File, Get_Name_String (Name));
 786
 787       --  If it was unsuccessful, display the first line in the file and exit
 788       --  with error.
 789
 790       if Return_Code /= 0 then
 791          Get_Line (File, Line, Last);
 792
 793          if not Keep_Temporary_Files then
 794             Delete (File);
 795          else
 796             Close (File);
 797          end if;
 798
 799          Put_Line (Standard_Error, Line (1 .. Last));
 800          Put_Line
 801            (Standard_Error, "could not get closure of " & ASIS_Main.all);
 802          raise Error_Exit;
 803
 804       else
 805          --  Get each file name in the file, find its path and add it the
 806          --  list of arguments.
 807
 808          while not End_Of_File (File) loop
 809             Get_Line (File, Line, Last);
 810             Path := No_Path;
 811
 812             Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
 813             while Unit /= No_Unit_Index loop
 814                if Unit.File_Names (Spec) /= null
 815                  and then
 816                    Get_Name_String (Unit.File_Names (Spec).File) =
 817                       Line (1 .. Last)
 818                then
 819                   Path := Unit.File_Names (Spec).Path.Name;
 820                   exit;
 821
 822                elsif Unit.File_Names (Impl) /= null
 823                  and then
 824                    Get_Name_String (Unit.File_Names (Impl).File) =
 825                      Line (1 .. Last)
 826                then
 827                   Path := Unit.File_Names (Impl).Path.Name;
 828                   exit;
 829                end if;
 830
 831                Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
 832             end loop;
 833
 834             Last_Switches.Increment_Last;
 835
 836             if Path /= No_Path then
 837                Last_Switches.Table (Last_Switches.Last) :=
 838                   new String'(Get_Name_String (Path));
 839
 840             else
 841                Last_Switches.Table (Last_Switches.Last) :=
 842                  new String'(Line (1 .. Last));
 843             end if;
 844          end loop;
 845
 846          if not Keep_Temporary_Files then
 847             Delete (File);
 848          else
 849             Close (File);
 850          end if;
 851       end if;
 852    end Get_Closure;
 853
 854    -----------
 855    -- Index --
 856    -----------
 857
 858    function Index (Char : Character; Str : String) return Natural is
 859    begin
 860       for Index in Str'Range loop
 861          if Str (Index) = Char then
 862             return Index;
 863          end if;
 864       end loop;
 865
 866       return 0;
 867    end Index;
 868
 869    ------------------
 870    -- Process_Link --
 871    ------------------
 872
 873    procedure Process_Link is
 874       Look_For_Executable : Boolean := True;
 875       Libraries_Present   : Boolean := False;
 876       Path_Option         : constant String_Access :=
 877                               MLib.Linker_Library_Path_Option;
 878       Prj                 : Project_Id := Project;
 879       Arg                 : String_Access;
 880       Last                : Natural := 0;
 881       Skip_Executable     : Boolean := False;
 882
 883    begin
 884       --  Add the default search directories, to be able to find
 885       --  libgnat in call to MLib.Utl.Lib_Directory.
 886
 887       Add_Default_Search_Dirs;
 888
 889       Library_Paths.Set_Last (0);
 890
 891       --  Check if there are library project files
 892
 893       if MLib.Tgt.Support_For_Libraries /= None then
 894          Set_Libraries (Project, Libraries_Present);
 895       end if;
 896
 897       --  If there are, add the necessary additional switches
 898
 899       if Libraries_Present then
 900
 901          --  Add -L<lib_dir> -lgnarl -lgnat -Wl,-rpath,<lib_dir>
 902
 903          Last_Switches.Increment_Last;
 904          Last_Switches.Table (Last_Switches.Last) :=
 905            new String'("-L" & MLib.Utl.Lib_Directory);
 906          Last_Switches.Increment_Last;
 907          Last_Switches.Table (Last_Switches.Last) :=
 908            new String'("-lgnarl");
 909          Last_Switches.Increment_Last;
 910          Last_Switches.Table (Last_Switches.Last) :=
 911            new String'("-lgnat");
 912
 913          --  If Path_Option is not null, create the switch ("-Wl,-rpath," or
 914          --  equivalent) with all the library dirs plus the standard GNAT
 915          --  library dir.
 916
 917          if Path_Option /= null then
 918             declare
 919                Option  : String_Access;
 920                Length  : Natural := Path_Option'Length;
 921                Current : Natural;
 922
 923             begin
 924                if MLib.Separate_Run_Path_Options then
 925
 926                   --  We are going to create one switch of the form
 927                   --  "-Wl,-rpath,dir_N" for each directory to consider.
 928
 929                   --  One switch for each library directory
 930
 931                   for Index in
 932                     Library_Paths.First .. Library_Paths.Last
 933                   loop
 934                      Last_Switches.Increment_Last;
 935                      Last_Switches.Table
 936                        (Last_Switches.Last) := new String'
 937                        (Path_Option.all &
 938                         Last_Switches.Table (Index).all);
 939                   end loop;
 940
 941                   --  One switch for the standard GNAT library dir
 942
 943                   Last_Switches.Increment_Last;
 944                   Last_Switches.Table
 945                     (Last_Switches.Last) := new String'
 946                     (Path_Option.all & MLib.Utl.Lib_Directory);
 947
 948                else
 949                   --  First, compute the exact length for the switch
 950
 951                   for Index in
 952                     Library_Paths.First .. Library_Paths.Last
 953                   loop
 954                      --  Add the length of the library dir plus one for the
 955                      --  directory separator.
 956
 957                      Length :=
 958                        Length +
 959                          Library_Paths.Table (Index)'Length + 1;
 960                   end loop;
 961
 962                   --  Finally, add the length of the standard GNAT library dir
 963
 964                   Length := Length + MLib.Utl.Lib_Directory'Length;
 965                   Option := new String (1 .. Length);
 966                   Option (1 .. Path_Option'Length) := Path_Option.all;
 967                   Current := Path_Option'Length;
 968
 969                   --  Put each library dir followed by a dir separator
 970
 971                   for Index in
 972                     Library_Paths.First .. Library_Paths.Last
 973                   loop
 974                      Option
 975                        (Current + 1 ..
 976                           Current +
 977                             Library_Paths.Table (Index)'Length) :=
 978                        Library_Paths.Table (Index).all;
 979                      Current :=
 980                        Current +
 981                          Library_Paths.Table (Index)'Length + 1;
 982                      Option (Current) := Path_Separator;
 983                   end loop;
 984
 985                   --  Finally put the standard GNAT library dir
 986
 987                   Option
 988                     (Current + 1 ..
 989                        Current + MLib.Utl.Lib_Directory'Length) :=
 990                       MLib.Utl.Lib_Directory;
 991
 992                   --  And add the switch to the last switches
 993
 994                   Last_Switches.Increment_Last;
 995                   Last_Switches.Table (Last_Switches.Last) :=
 996                     Option;
 997                end if;
 998             end;
 999          end if;
1000       end if;
1001
1002       --  Check if the first ALI file specified can be found, either in the
1003       --  object directory of the main project or in an object directory of a
1004       --  project file extended by the main project. If the ALI file can be
1005       --  found, replace its name with its absolute path.
1006
1007       Skip_Executable := False;
1008
1009       Switch_Loop : for J in 1 .. Last_Switches.Last loop
1010
1011          --  If we have an executable just reset the flag
1012
1013          if Skip_Executable then
1014             Skip_Executable := False;
1015
1016          --  If -o, set flag so that next switch is not processed
1017
1018          elsif Last_Switches.Table (J).all = "-o" then
1019             Skip_Executable := True;
1020
1021          --  Normal case
1022
1023          else
1024             declare
1025                Switch    : constant String :=
1026                              Last_Switches.Table (J).all;
1027                ALI_File  : constant String (1 .. Switch'Length + 4) :=
1028                              Switch & ".ali";
1029
1030                Test_Existence : Boolean := False;
1031
1032             begin
1033                Last := Switch'Length;
1034
1035                --  Skip real switches
1036
1037                if Switch'Length /= 0
1038                  and then Switch (Switch'First) /= '-'
1039                then
1040                   --  Append ".ali" if file name does not end with it
1041
1042                   if Switch'Length <= 4
1043                     or else Switch (Switch'Last - 3 .. Switch'Last)
1044                     /= ".ali"
1045                   then
1046                      Last := ALI_File'Last;
1047                   end if;
1048
1049                   --  If file name includes directory information, stop if ALI
1050                   --  file exists.
1051
1052                   if Is_Absolute_Path (ALI_File (1 .. Last)) then
1053                      Test_Existence := True;
1054
1055                   else
1056                      for K in Switch'Range loop
1057                         if Switch (K) = '/' or else
1058                           Switch (K) = Directory_Separator
1059                         then
1060                            Test_Existence := True;
1061                            exit;
1062                         end if;
1063                      end loop;
1064                   end if;
1065
1066                   if Test_Existence then
1067                      if Is_Regular_File (ALI_File (1 .. Last)) then
1068                         exit Switch_Loop;
1069                      end if;
1070
1071                   --  Look in object directories if ALI file exists
1072
1073                   else
1074                      Project_Loop : loop
1075                         declare
1076                            Dir : constant String :=
1077                                    Get_Name_String (Prj.Object_Directory.Name);
1078                         begin
1079                            if Is_Regular_File
1080                                 (Dir &
1081                                  Directory_Separator &
1082                                  ALI_File (1 .. Last))
1083                            then
1084                               --  We have found the correct project, so we
1085                               --  replace the file with the absolute path.
1086
1087                               Last_Switches.Table (J) :=
1088                                 new String'
1089                                   (Dir & Directory_Separator &
1090                                    ALI_File (1 .. Last));
1091
1092                               --  And we are done
1093
1094                               exit Switch_Loop;
1095                            end if;
1096                         end;
1097
1098                         --  Go to the project being extended, if any
1099
1100                         Prj := Prj.Extends;
1101                         exit Project_Loop when Prj = No_Project;
1102                      end loop Project_Loop;
1103                   end if;
1104                end if;
1105             end;
1106          end if;
1107       end loop Switch_Loop;
1108
1109       --  If a relative path output file has been specified, we add the exec
1110       --  directory.
1111
1112       for J in reverse 1 .. Last_Switches.Last - 1 loop
1113          if Last_Switches.Table (J).all = "-o" then
1114             Check_Relative_Executable
1115               (Name => Last_Switches.Table (J + 1));
1116             Look_For_Executable := False;
1117             exit;
1118          end if;
1119       end loop;
1120
1121       if Look_For_Executable then
1122          for J in reverse 1 .. First_Switches.Last - 1 loop
1123             if First_Switches.Table (J).all = "-o" then
1124                Look_For_Executable := False;
1125                Check_Relative_Executable
1126                  (Name => First_Switches.Table (J + 1));
1127                exit;
1128             end if;
1129          end loop;
1130       end if;
1131
1132       --  If no executable is specified, then find the name of the first ALI
1133       --  file on the command line and issue a -o switch with the absolute path
1134       --  of the executable in the exec directory.
1135
1136       if Look_For_Executable then
1137          for J in 1 .. Last_Switches.Last loop
1138             Arg  := Last_Switches.Table (J);
1139             Last := 0;
1140
1141             if Arg'Length /= 0 and then Arg (Arg'First) /= '-' then
1142                if Arg'Length > 4
1143                  and then Arg (Arg'Last - 3 .. Arg'Last) = ".ali"
1144                then
1145                   Last := Arg'Last - 4;
1146
1147                elsif Is_Regular_File (Arg.all & ".ali") then
1148                   Last := Arg'Last;
1149                end if;
1150
1151                if Last /= 0 then
1152                   Last_Switches.Increment_Last;
1153                   Last_Switches.Table (Last_Switches.Last) :=
1154                     new String'("-o");
1155                   Get_Name_String (Project.Exec_Directory.Name);
1156                   Last_Switches.Increment_Last;
1157                   Last_Switches.Table (Last_Switches.Last) :=
1158                     new String'(Name_Buffer (1 .. Name_Len) &
1159                                 Directory_Separator &
1160                                 Executable_Name
1161                                   (Base_Name (Arg (Arg'First .. Last))));
1162                   exit;
1163                end if;
1164             end if;
1165          end loop;
1166       end if;
1167    end Process_Link;
1168
1169    ---------------------
1170    -- Set_Library_For --
1171    ---------------------
1172
1173    procedure Set_Library_For
1174      (Project           : Project_Id;
1175       Libraries_Present : in out Boolean)
1176    is
1177       Path_Option : constant String_Access :=
1178                       MLib.Linker_Library_Path_Option;
1179
1180    begin
1181       --  Case of library project
1182
1183       if Project.Library then
1184          Libraries_Present := True;
1185
1186          --  Add the -L switch
1187
1188          Last_Switches.Increment_Last;
1189          Last_Switches.Table (Last_Switches.Last) :=
1190            new String'("-L" & Get_Name_String (Project.Library_Dir.Name));
1191
1192          --  Add the -l switch
1193
1194          Last_Switches.Increment_Last;
1195          Last_Switches.Table (Last_Switches.Last) :=
1196            new String'("-l" & Get_Name_String (Project.Library_Name));
1197
1198          --  Add the directory to table Library_Paths, to be processed later
1199          --  if library is not static and if Path_Option is not null.
1200
1201          if Project.Library_Kind /= Static
1202            and then Path_Option /= null
1203          then
1204             Library_Paths.Increment_Last;
1205             Library_Paths.Table (Library_Paths.Last) :=
1206               new String'(Get_Name_String (Project.Library_Dir.Name));
1207          end if;
1208       end if;
1209    end Set_Library_For;
1210
1211    ---------------------------
1212    -- Test_If_Relative_Path --
1213    ---------------------------
1214
1215    procedure Test_If_Relative_Path
1216      (Switch : in out String_Access;
1217       Parent : String)
1218    is
1219    begin
1220       Makeutl.Test_If_Relative_Path
1221         (Switch, Parent, Including_Non_Switch => False, Including_RTS => True);
1222    end Test_If_Relative_Path;
1223
1224    -------------------
1225    -- Non_VMS_Usage --
1226    -------------------
1227
1228    procedure Non_VMS_Usage is
1229    begin
1230       Output_Version;
1231       New_Line;
1232       Put_Line ("List of available commands");
1233       New_Line;
1234
1235       for C in Command_List'Range loop
1236          if not Command_List (C).VMS_Only then
1237             if Targparm.AAMP_On_Target then
1238                Put ("gnaampcmd ");
1239             else
1240                Put ("gnat ");
1241             end if;
1242
1243             Put (To_Lower (Command_List (C).Cname.all));
1244             Set_Col (25);
1245
1246             --  Never call gnatstack with a prefix
1247
1248             if C = Stack then
1249                Put (Command_List (C).Unixcmd.all);
1250             else
1251                Put (Program_Name (Command_List (C).Unixcmd.all, "gnat").all);
1252             end if;
1253
1254             declare
1255                Sws : Argument_List_Access renames Command_List (C).Unixsws;
1256             begin
1257                if Sws /= null then
1258                   for J in Sws'Range loop
1259                      Put (' ');
1260                      Put (Sws (J).all);
1261                   end loop;
1262                end if;
1263             end;
1264
1265             New_Line;
1266          end if;
1267       end loop;
1268
1269       New_Line;
1270       Put_Line ("Commands find, list, metric, pretty, stack, stub and xref " &
1271                 "accept project file switches -vPx, -Pprj and -Xnam=val");
1272       New_Line;
1273    end Non_VMS_Usage;
1274
1275    -------------------------------------
1276    -- Start of processing for GNATCmd --
1277    -------------------------------------
1278
1279 begin
1280    --  Initializations
1281
1282    Namet.Initialize;
1283    Csets.Initialize;
1284
1285    Snames.Initialize;
1286
1287    Prj.Initialize (Project_Tree);
1288
1289    Last_Switches.Init;
1290    Last_Switches.Set_Last (0);
1291
1292    First_Switches.Init;
1293    First_Switches.Set_Last (0);
1294    Carg_Switches.Init;
1295    Carg_Switches.Set_Last (0);
1296    Rules_Switches.Init;
1297    Rules_Switches.Set_Last (0);
1298
1299    VMS_Conv.Initialize;
1300
1301    Set_Mode (Ada_Only);
1302
1303    --  Add the default search directories, to be able to find system.ads in the
1304    --  subsequent call to Targparm.Get_Target_Parameters.
1305
1306    Add_Default_Search_Dirs;
1307
1308    --  Get target parameters so that AAMP_On_Target will be set, for testing in
1309    --  Osint.Program_Name to handle the mapping of GNAAMP tool names.
1310
1311    Targparm.Get_Target_Parameters;
1312
1313    --  Add the directory where the GNAT driver is invoked in front of the path,
1314    --  if the GNAT driver is invoked with directory information. Do not do this
1315    --  for VMS, where the notion of path does not really exist.
1316
1317    if not OpenVMS then
1318       declare
1319          Command : constant String := Command_Name;
1320
1321       begin
1322          for Index in reverse Command'Range loop
1323             if Command (Index) = Directory_Separator then
1324                declare
1325                   Absolute_Dir : constant String :=
1326                                    Normalize_Pathname
1327                                      (Command (Command'First .. Index));
1328
1329                   PATH         : constant String :=
1330                                    Absolute_Dir &
1331                   Path_Separator &
1332                   Getenv ("PATH").all;
1333
1334                begin
1335                   Setenv ("PATH", PATH);
1336                end;
1337
1338                exit;
1339             end if;
1340          end loop;
1341       end;
1342    end if;
1343
1344    --  If on VMS, or if VMS emulation is on, convert VMS style /qualifiers,
1345    --  filenames and pathnames to Unix style.
1346
1347    if Hostparm.OpenVMS
1348      or else To_Lower (Getenv ("EMULATE_VMS").all) = "true"
1349    then
1350       VMS_Conversion (The_Command);
1351
1352       B_Start := new String'("b__");
1353
1354    --  If not on VMS, scan the command line directly
1355
1356    else
1357       if Argument_Count = 0 then
1358          Non_VMS_Usage;
1359          return;
1360       else
1361          begin
1362             loop
1363                if Argument_Count > Command_Arg
1364                  and then Argument (Command_Arg) = "-v"
1365                then
1366                   Verbose_Mode := True;
1367                   Command_Arg := Command_Arg + 1;
1368
1369                elsif Argument_Count > Command_Arg
1370                  and then Argument (Command_Arg) = "-dn"
1371                then
1372                   Keep_Temporary_Files := True;
1373                   Command_Arg := Command_Arg + 1;
1374
1375                else
1376                   exit;
1377                end if;
1378             end loop;
1379
1380             The_Command := Real_Command_Type'Value (Argument (Command_Arg));
1381
1382             if Command_List (The_Command).VMS_Only then
1383                Non_VMS_Usage;
1384                Fail
1385                  ("Command """
1386                   & Command_List (The_Command).Cname.all
1387                   & """ can only be used on VMS");
1388             end if;
1389
1390          exception
1391             when Constraint_Error =>
1392
1393                --  Check if it is an alternate command
1394
1395                declare
1396                   Alternate : Alternate_Command;
1397
1398                begin
1399                   Alternate := Alternate_Command'Value
1400                                               (Argument (Command_Arg));
1401                   The_Command := Corresponding_To (Alternate);
1402
1403                exception
1404                   when Constraint_Error =>
1405                      Non_VMS_Usage;
1406                      Fail ("Unknown command: " & Argument (Command_Arg));
1407                end;
1408          end;
1409
1410          --  Get the arguments from the command line and from the eventual
1411          --  argument file(s) specified on the command line.
1412
1413          for Arg in Command_Arg + 1 .. Argument_Count loop
1414             declare
1415                The_Arg : constant String := Argument (Arg);
1416
1417             begin
1418                --  Check if an argument file is specified
1419
1420                if The_Arg (The_Arg'First) = '@' then
1421                   declare
1422                      Arg_File : Ada.Text_IO.File_Type;
1423                      Line     : String (1 .. 256);
1424                      Last     : Natural;
1425
1426                   begin
1427                      --  Open the file and fail if the file cannot be found
1428
1429                      begin
1430                         Open
1431                           (Arg_File, In_File,
1432                            The_Arg (The_Arg'First + 1 .. The_Arg'Last));
1433
1434                      exception
1435                         when others =>
1436                            Put
1437                              (Standard_Error, "Cannot open argument file """);
1438                            Put
1439                              (Standard_Error,
1440                               The_Arg (The_Arg'First + 1 .. The_Arg'Last));
1441
1442                            Put_Line (Standard_Error, """");
1443                            raise Error_Exit;
1444                      end;
1445
1446                      --  Read line by line and put the content of each non-
1447                      --  empty line in the Last_Switches table.
1448
1449                      while not End_Of_File (Arg_File) loop
1450                         Get_Line (Arg_File, Line, Last);
1451
1452                         if Last /= 0 then
1453                            Last_Switches.Increment_Last;
1454                            Last_Switches.Table (Last_Switches.Last) :=
1455                              new String'(Line (1 .. Last));
1456                         end if;
1457                      end loop;
1458
1459                      Close (Arg_File);
1460                   end;
1461
1462                else
1463                   --  It is not an argument file; just put the argument in
1464                   --  the Last_Switches table.
1465
1466                   Last_Switches.Increment_Last;
1467                   Last_Switches.Table (Last_Switches.Last) :=
1468                     new String'(The_Arg);
1469                end if;
1470             end;
1471          end loop;
1472       end if;
1473    end if;
1474
1475    declare
1476       Program   : String_Access;
1477       Exec_Path : String_Access;
1478
1479    begin
1480       if The_Command = Stack then
1481          --  Never call gnatstack with a prefix
1482
1483          Program := new String'(Command_List (The_Command).Unixcmd.all);
1484
1485       else
1486          Program :=
1487            Program_Name (Command_List (The_Command).Unixcmd.all, "gnat");
1488       end if;
1489
1490       --  Locate the executable for the command
1491
1492       Exec_Path := Locate_Exec_On_Path (Program.all);
1493
1494       if Exec_Path = null then
1495          Put_Line (Standard_Error, "could not locate " & Program.all);
1496          raise Error_Exit;
1497       end if;
1498
1499       --  If there are switches for the executable, put them as first switches
1500
1501       if Command_List (The_Command).Unixsws /= null then
1502          for J in Command_List (The_Command).Unixsws'Range loop
1503             First_Switches.Increment_Last;
1504             First_Switches.Table (First_Switches.Last) :=
1505               Command_List (The_Command).Unixsws (J);
1506          end loop;
1507       end if;
1508
1509       --  For BIND, CHECK, ELIM, FIND, LINK, LIST, PRETTY, STACK, STUB,
1510       --  METRIC ad  XREF, look for project file related switches.
1511
1512       if The_Command = Bind
1513         or else The_Command = Check
1514         or else The_Command = Sync
1515         or else The_Command = Elim
1516         or else The_Command = Find
1517         or else The_Command = Link
1518         or else The_Command = List
1519         or else The_Command = Xref
1520         or else The_Command = Pretty
1521         or else The_Command = Stack
1522         or else The_Command = Stub
1523         or else The_Command = Metric
1524       then
1525          case The_Command is
1526             when Bind =>
1527                Tool_Package_Name := Name_Binder;
1528                Packages_To_Check := Packages_To_Check_By_Binder;
1529             when Check =>
1530                Tool_Package_Name := Name_Check;
1531                Packages_To_Check := Packages_To_Check_By_Check;
1532             when Sync =>
1533                Tool_Package_Name := Name_Synchronize;
1534                Packages_To_Check := Packages_To_Check_By_Sync;
1535             when Elim =>
1536                Tool_Package_Name := Name_Eliminate;
1537                Packages_To_Check := Packages_To_Check_By_Eliminate;
1538             when Find =>
1539                Tool_Package_Name := Name_Finder;
1540                Packages_To_Check := Packages_To_Check_By_Finder;
1541             when Link =>
1542                Tool_Package_Name := Name_Linker;
1543                Packages_To_Check := Packages_To_Check_By_Linker;
1544             when List =>
1545                Tool_Package_Name := Name_Gnatls;
1546                Packages_To_Check := Packages_To_Check_By_Gnatls;
1547             when Metric =>
1548                Tool_Package_Name := Name_Metrics;
1549                Packages_To_Check := Packages_To_Check_By_Metric;
1550             when Pretty =>
1551                Tool_Package_Name := Name_Pretty_Printer;
1552                Packages_To_Check := Packages_To_Check_By_Pretty;
1553             when Stack =>
1554                Tool_Package_Name := Name_Stack;
1555                Packages_To_Check := Packages_To_Check_By_Stack;
1556             when Stub =>
1557                Tool_Package_Name := Name_Gnatstub;
1558                Packages_To_Check := Packages_To_Check_By_Gnatstub;
1559             when Xref =>
1560                Tool_Package_Name := Name_Cross_Reference;
1561                Packages_To_Check := Packages_To_Check_By_Xref;
1562             when others =>
1563                null;
1564          end case;
1565
1566          --  Check that the switches are consistent. Detect project file
1567          --  related switches.
1568
1569          Inspect_Switches :
1570          declare
1571             Arg_Num : Positive := 1;
1572             Argv    : String_Access;
1573
1574             procedure Remove_Switch (Num : Positive);
1575             --  Remove a project related switch from table Last_Switches
1576
1577             -------------------
1578             -- Remove_Switch --
1579             -------------------
1580
1581             procedure Remove_Switch (Num : Positive) is
1582             begin
1583                Last_Switches.Table (Num .. Last_Switches.Last - 1) :=
1584                  Last_Switches.Table (Num + 1 .. Last_Switches.Last);
1585                Last_Switches.Decrement_Last;
1586             end Remove_Switch;
1587
1588          --  Start of processing for Inspect_Switches
1589
1590          begin
1591             while Arg_Num <= Last_Switches.Last loop
1592                Argv := Last_Switches.Table (Arg_Num);
1593
1594                if Argv (Argv'First) = '-' then
1595                   if Argv'Length = 1 then
1596                      Fail
1597                        ("switch character cannot be followed by a blank");
1598                   end if;
1599
1600                   --  The two style project files (-p and -P) cannot be used
1601                   --  together
1602
1603                   if (The_Command = Find or else The_Command = Xref)
1604                     and then Argv (2) = 'p'
1605                   then
1606                      Old_Project_File_Used := True;
1607                      if Project_File /= null then
1608                         Fail ("-P and -p cannot be used together");
1609                      end if;
1610                   end if;
1611
1612                   --  --subdirs=... Specify Subdirs
1613
1614                   if Argv'Length > Makeutl.Subdirs_Option'Length and then
1615                     Argv
1616                      (Argv'First ..
1617                       Argv'First + Makeutl.Subdirs_Option'Length - 1) =
1618                         Makeutl.Subdirs_Option
1619                   then
1620                      Subdirs :=
1621                        new String'
1622                          (Argv
1623                            (Argv'First + Makeutl.Subdirs_Option'Length ..
1624                             Argv'Last));
1625
1626                      Remove_Switch (Arg_Num);
1627
1628                   --  -aPdir  Add dir to the project search path
1629
1630                   elsif Argv'Length > 3
1631                     and then Argv (Argv'First + 1 .. Argv'First + 2) = "aP"
1632                   then
1633                      Add_Search_Project_Directory
1634                        (Argv (Argv'First + 3 .. Argv'Last));
1635
1636                      Remove_Switch (Arg_Num);
1637
1638                   --  -eL  Follow links for files
1639
1640                   elsif Argv.all = "-eL" then
1641                      Follow_Links_For_Files := True;
1642
1643                      Remove_Switch (Arg_Num);
1644
1645                   --  -vPx  Specify verbosity while parsing project files
1646
1647                   elsif Argv'Length = 4
1648                     and then Argv (Argv'First + 1 .. Argv'First + 2) = "vP"
1649                   then
1650                      case Argv (Argv'Last) is
1651                         when '0' =>
1652                            Current_Verbosity := Prj.Default;
1653                         when '1' =>
1654                            Current_Verbosity := Prj.Medium;
1655                         when '2' =>
1656                            Current_Verbosity := Prj.High;
1657                         when others =>
1658                            Fail ("Invalid switch: " & Argv.all);
1659                      end case;
1660
1661                      Remove_Switch (Arg_Num);
1662
1663                   --  -Pproject_file  Specify project file to be used
1664
1665                   elsif Argv (Argv'First + 1) = 'P' then
1666
1667                      --  Only one -P switch can be used
1668
1669                      if Project_File /= null then
1670                         Fail
1671                           (Argv.all
1672                            & ": second project file forbidden (first is """
1673                            & Project_File.all
1674                            & """)");
1675
1676                      --  The two style project files (-p and -P) cannot be
1677                      --  used together.
1678
1679                      elsif Old_Project_File_Used then
1680                         Fail ("-p and -P cannot be used together");
1681
1682                      elsif Argv'Length = 2 then
1683
1684                         --  There is space between -P and the project file
1685                         --  name. -P cannot be the last option.
1686
1687                         if Arg_Num = Last_Switches.Last then
1688                            Fail ("project file name missing after -P");
1689
1690                         else
1691                            Remove_Switch (Arg_Num);
1692                            Argv := Last_Switches.Table (Arg_Num);
1693
1694                            --  After -P, there must be a project file name,
1695                            --  not another switch.
1696
1697                            if Argv (Argv'First) = '-' then
1698                               Fail ("project file name missing after -P");
1699
1700                            else
1701                               Project_File := new String'(Argv.all);
1702                            end if;
1703                         end if;
1704
1705                      else
1706                         --  No space between -P and project file name
1707
1708                         Project_File :=
1709                           new String'(Argv (Argv'First + 2 .. Argv'Last));
1710                      end if;
1711
1712                      Remove_Switch (Arg_Num);
1713
1714                   --  -Xexternal=value Specify an external reference to be
1715                   --                   used in project files
1716
1717                   elsif Argv'Length >= 5
1718                     and then Argv (Argv'First + 1) = 'X'
1719                   then
1720                      declare
1721                         Equal_Pos : constant Natural :=
1722                                       Index
1723                                         ('=',
1724                                          Argv (Argv'First + 2 .. Argv'Last));
1725                      begin
1726                         if Equal_Pos >= Argv'First + 3 and then
1727                           Equal_Pos /= Argv'Last then
1728                            Add (External_Name =>
1729                                   Argv (Argv'First + 2 .. Equal_Pos - 1),
1730                                 Value => Argv (Equal_Pos + 1 .. Argv'Last));
1731                         else
1732                            Fail
1733                              (Argv.all
1734                               & " is not a valid external assignment.");
1735                         end if;
1736                      end;
1737
1738                      Remove_Switch (Arg_Num);
1739
1740                   elsif
1741                     (The_Command = Check  or else
1742                      The_Command = Sync   or else
1743                      The_Command = Pretty or else
1744                      The_Command = Metric or else
1745                      The_Command = Stack  or else
1746                      The_Command = List)
1747                     and then Argv'Length = 2
1748                     and then Argv (2) = 'U'
1749                   then
1750                      All_Projects := True;
1751                      Remove_Switch (Arg_Num);
1752
1753                   else
1754                      Arg_Num := Arg_Num + 1;
1755                   end if;
1756
1757                elsif ((The_Command = Check and then Argv (Argv'First) /= '+')
1758                         or else The_Command = Sync
1759                         or else The_Command = Metric
1760                         or else The_Command = Pretty)
1761                  and then Project_File /= null
1762                  and then All_Projects
1763                then
1764                   if ASIS_Main /= null then
1765                      Fail ("cannot specify more than one main after -U");
1766                   else
1767                      ASIS_Main := Argv;
1768                      Remove_Switch (Arg_Num);
1769                   end if;
1770
1771                else
1772                   Arg_Num := Arg_Num + 1;
1773                end if;
1774             end loop;
1775          end Inspect_Switches;
1776       end if;
1777
1778       --  If there is a project file specified, parse it, get the switches
1779       --  for the tool and setup PATH environment variables.
1780
1781       if Project_File /= null then
1782          Prj.Pars.Set_Verbosity (To => Current_Verbosity);
1783
1784          Prj.Pars.Parse
1785            (Project           => Project,
1786             In_Tree           => Project_Tree,
1787             Project_File_Name => Project_File.all,
1788             Packages_To_Check => Packages_To_Check,
1789             Is_Config_File    => False);
1790
1791          if Project = Prj.No_Project then
1792             Fail ("""" & Project_File.all & """ processing failed");
1793          end if;
1794
1795          --  Check if a package with the name of the tool is in the project
1796          --  file and if there is one, get the switches, if any, and scan them.
1797
1798          declare
1799             Pkg : constant Prj.Package_Id :=
1800                     Prj.Util.Value_Of
1801                       (Name        => Tool_Package_Name,
1802                        In_Packages => Project.Decl.Packages,
1803                        In_Tree     => Project_Tree);
1804
1805             Element : Package_Element;
1806
1807             Default_Switches_Array : Array_Element_Id;
1808
1809             The_Switches : Prj.Variable_Value;
1810             Current      : Prj.String_List_Id;
1811             The_String   : String_Element;
1812
1813          begin
1814             if Pkg /= No_Package then
1815                Element := Project_Tree.Packages.Table (Pkg);
1816
1817                --  Packages Gnatls and Gnatstack have a single attribute
1818                --  Switches, that is not an associative array.
1819
1820                if The_Command = List or else The_Command = Stack then
1821                   The_Switches :=
1822                     Prj.Util.Value_Of
1823                     (Variable_Name => Snames.Name_Switches,
1824                      In_Variables  => Element.Decl.Attributes,
1825                      In_Tree       => Project_Tree);
1826
1827                --  Packages Binder (for gnatbind), Cross_Reference (for
1828                --  gnatxref), Linker (for gnatlink), Finder (for gnatfind),
1829                --  Pretty_Printer (for gnatpp), Eliminate (for gnatelim), Check
1830                --  (for gnatcheck), and Metric (for gnatmetric) have an
1831                --  attributed Switches, an associative array, indexed by the
1832                --  name of the file.
1833
1834                --  They also have an attribute Default_Switches, indexed by the
1835                --  name of the programming language.
1836
1837                else
1838                   if The_Switches.Kind = Prj.Undefined then
1839                      Default_Switches_Array :=
1840                        Prj.Util.Value_Of
1841                          (Name      => Name_Default_Switches,
1842                           In_Arrays => Element.Decl.Arrays,
1843                           In_Tree   => Project_Tree);
1844                      The_Switches := Prj.Util.Value_Of
1845                        (Index     => Name_Ada,
1846                         Src_Index => 0,
1847                         In_Array  => Default_Switches_Array,
1848                         In_Tree   => Project_Tree);
1849                   end if;
1850                end if;
1851
1852                --  If there are switches specified in the package of the
1853                --  project file corresponding to the tool, scan them.
1854
1855                case The_Switches.Kind is
1856                   when Prj.Undefined =>
1857                      null;
1858
1859                   when Prj.Single =>
1860                      declare
1861                         Switch : constant String :=
1862                                    Get_Name_String (The_Switches.Value);
1863
1864                      begin
1865                         if Switch'Length > 0 then
1866                            First_Switches.Increment_Last;
1867                            First_Switches.Table (First_Switches.Last) :=
1868                              new String'(Switch);
1869                         end if;
1870                      end;
1871
1872                   when Prj.List =>
1873                      Current := The_Switches.Values;
1874                      while Current /= Prj.Nil_String loop
1875                         The_String := Project_Tree.String_Elements.
1876                                         Table (Current);
1877
1878                         declare
1879                            Switch : constant String :=
1880                              Get_Name_String (The_String.Value);
1881
1882                         begin
1883                            if Switch'Length > 0 then
1884                               First_Switches.Increment_Last;
1885                               First_Switches.Table (First_Switches.Last) :=
1886                                 new String'(Switch);
1887                            end if;
1888                         end;
1889
1890                         Current := The_String.Next;
1891                      end loop;
1892                end case;
1893             end if;
1894          end;
1895
1896          if The_Command = Bind
1897            or else The_Command = Link
1898            or else The_Command = Elim
1899          then
1900             Change_Dir (Get_Name_String (Project.Object_Directory.Name));
1901          end if;
1902
1903          --  Set up the env vars for project path files
1904
1905          Prj.Env.Set_Ada_Paths
1906            (Project, Project_Tree, Including_Libraries => False);
1907
1908          --  For gnatcheck, gnatstub, gnatmetric, gnatpp and gnatelim, create
1909          --  a configuration pragmas file, if necessary.
1910
1911          if The_Command = Pretty
1912            or else The_Command = Metric
1913            or else The_Command = Stub
1914            or else The_Command = Elim
1915            or else The_Command = Check
1916            or else The_Command = Sync
1917          then
1918             --  If there are switches in package Compiler, put them in the
1919             --  Carg_Switches table.
1920
1921             declare
1922                Pkg  : constant Prj.Package_Id :=
1923                         Prj.Util.Value_Of
1924                           (Name        => Name_Compiler,
1925                            In_Packages => Project.Decl.Packages,
1926                            In_Tree     => Project_Tree);
1927
1928                Element : Package_Element;
1929
1930                Default_Switches_Array : Array_Element_Id;
1931
1932                The_Switches : Prj.Variable_Value;
1933                Current      : Prj.String_List_Id;
1934                The_String   : String_Element;
1935
1936             begin
1937                if Pkg /= No_Package then
1938                   Element := Project_Tree.Packages.Table (Pkg);
1939
1940                   Default_Switches_Array :=
1941                     Prj.Util.Value_Of
1942                       (Name      => Name_Default_Switches,
1943                        In_Arrays => Element.Decl.Arrays,
1944                        In_Tree   => Project_Tree);
1945                   The_Switches := Prj.Util.Value_Of
1946                     (Index     => Name_Ada,
1947                      Src_Index => 0,
1948                      In_Array  => Default_Switches_Array,
1949                      In_Tree   => Project_Tree);
1950
1951                   --  If there are switches specified in the package of the
1952                   --  project file corresponding to the tool, scan them.
1953
1954                   case The_Switches.Kind is
1955                      when Prj.Undefined =>
1956                         null;
1957
1958                      when Prj.Single =>
1959                         declare
1960                            Switch : constant String :=
1961                                       Get_Name_String (The_Switches.Value);
1962                         begin
1963                            if Switch'Length > 0 then
1964                               Add_To_Carg_Switches (new String'(Switch));
1965                            end if;
1966                         end;
1967
1968                      when Prj.List =>
1969                         Current := The_Switches.Values;
1970                         while Current /= Prj.Nil_String loop
1971                            The_String :=
1972                              Project_Tree.String_Elements.Table (Current);
1973
1974                            declare
1975                               Switch : constant String :=
1976                                          Get_Name_String (The_String.Value);
1977                            begin
1978                               if Switch'Length > 0 then
1979                                  Add_To_Carg_Switches (new String'(Switch));
1980                               end if;
1981                            end;
1982
1983                            Current := The_String.Next;
1984                         end loop;
1985                   end case;
1986                end if;
1987             end;
1988
1989             --  If -cargs is one of the switches, move the following switches
1990             --  to the Carg_Switches table.
1991
1992             for J in 1 .. First_Switches.Last loop
1993                if First_Switches.Table (J).all = "-cargs" then
1994                   declare
1995                      K    : Positive;
1996                      Last : Natural;
1997
1998                   begin
1999                      --  Move the switches that are before -rules when the
2000                      --  command is CHECK.
2001
2002                      K := J + 1;
2003                      while K <= First_Switches.Last
2004                        and then
2005                         (The_Command /= Check
2006                            or else First_Switches.Table (K).all /= "-rules")
2007                      loop
2008                         Add_To_Carg_Switches (First_Switches.Table (K));
2009                         K := K + 1;
2010                      end loop;
2011
2012                      if K > First_Switches.Last then
2013                         First_Switches.Set_Last (J - 1);
2014
2015                      else
2016                         Last := J - 1;
2017                         while K <= First_Switches.Last loop
2018                            Last := Last + 1;
2019                            First_Switches.Table (Last) :=
2020                              First_Switches.Table (K);
2021                            K := K + 1;
2022                         end loop;
2023
2024                         First_Switches.Set_Last (Last);
2025                      end if;
2026                   end;
2027
2028                   exit;
2029                end if;
2030             end loop;
2031
2032             for J in 1 .. Last_Switches.Last loop
2033                if Last_Switches.Table (J).all = "-cargs" then
2034                   declare
2035                      K    : Positive;
2036                      Last : Natural;
2037
2038                   begin
2039                      --  Move the switches that are before -rules when the
2040                      --  command is CHECK.
2041
2042                      K := J + 1;
2043                      while K <= Last_Switches.Last
2044                        and then
2045                         (The_Command /= Check
2046                          or else
2047                          Last_Switches.Table (K).all /= "-rules")
2048                      loop
2049                         Add_To_Carg_Switches (Last_Switches.Table (K));
2050                         K := K + 1;
2051                      end loop;
2052
2053                      if K > Last_Switches.Last then
2054                         Last_Switches.Set_Last (J - 1);
2055
2056                      else
2057                         Last := J - 1;
2058                         while K <= Last_Switches.Last loop
2059                            Last := Last + 1;
2060                            Last_Switches.Table (Last) :=
2061                              Last_Switches.Table (K);
2062                            K := K + 1;
2063                         end loop;
2064
2065                         Last_Switches.Set_Last (Last);
2066                      end if;
2067                   end;
2068
2069                   exit;
2070                end if;
2071             end loop;
2072
2073             declare
2074                CP_File : constant Path_Name_Type := Configuration_Pragmas_File;
2075
2076             begin
2077                if CP_File /= No_Path then
2078                   if The_Command = Elim then
2079                      First_Switches.Increment_Last;
2080                      First_Switches.Table (First_Switches.Last)  :=
2081                        new String'("-C" & Get_Name_String (CP_File));
2082
2083                   else
2084                      Add_To_Carg_Switches
2085                        (new String'("-gnatec=" & Get_Name_String (CP_File)));
2086                   end if;
2087                end if;
2088             end;
2089          end if;
2090
2091          if The_Command = Link then
2092             Process_Link;
2093          end if;
2094
2095          if The_Command = Link or The_Command = Bind then
2096
2097             --  For files that are specified as relative paths with directory
2098             --  information, we convert them to absolute paths, with parent
2099             --  being the current working directory if specified on the command
2100             --  line and the project directory if specified in the project
2101             --  file. This is what gnatmake is doing for linker and binder
2102             --  arguments.
2103
2104             for J in 1 .. Last_Switches.Last loop
2105                Test_If_Relative_Path
2106                  (Last_Switches.Table (J), Current_Work_Dir);
2107             end loop;
2108
2109             Get_Name_String (Project.Directory.Name);
2110
2111             declare
2112                Project_Dir : constant String := Name_Buffer (1 .. Name_Len);
2113             begin
2114                for J in 1 .. First_Switches.Last loop
2115                   Test_If_Relative_Path
2116                     (First_Switches.Table (J), Project_Dir);
2117                end loop;
2118             end;
2119
2120          elsif The_Command = Stub then
2121             declare
2122                File_Index : Integer := 0;
2123                Dir_Index  : Integer := 0;
2124                Last       : constant Integer := Last_Switches.Last;
2125
2126             begin
2127                for Index in 1 .. Last loop
2128                   if Last_Switches.Table (Index)
2129                     (Last_Switches.Table (Index)'First) /= '-'
2130                   then
2131                      File_Index := Index;
2132                      exit;
2133                   end if;
2134                end loop;
2135
2136                --  If the naming scheme of the project file is not standard,
2137                --  and if the file name ends with the spec suffix, then
2138                --  indicate to gnatstub the name of the body file with
2139                --  a -o switch.
2140
2141                if Body_Suffix_Id_Of (Project_Tree, Name_Ada, Project.Naming) /=
2142                     Prj.Default_Ada_Spec_Suffix
2143                then
2144                   if File_Index /= 0 then
2145                      declare
2146                         Spec : constant String :=
2147                           Base_Name (Last_Switches.Table (File_Index).all);
2148                         Last : Natural := Spec'Last;
2149
2150                      begin
2151                         Get_Name_String
2152                           (Spec_Suffix_Id_Of
2153                              (Project_Tree, Name_Ada, Project.Naming));
2154
2155                         if Spec'Length > Name_Len
2156                           and then Spec (Last - Name_Len + 1 .. Last) =
2157                                                   Name_Buffer (1 .. Name_Len)
2158                         then
2159                            Last := Last - Name_Len;
2160                            Get_Name_String
2161                              (Body_Suffix_Id_Of
2162                                 (Project_Tree, Name_Ada, Project.Naming));
2163                            Last_Switches.Increment_Last;
2164                            Last_Switches.Table (Last_Switches.Last) :=
2165                              new String'("-o");
2166                            Last_Switches.Increment_Last;
2167                            Last_Switches.Table (Last_Switches.Last) :=
2168                              new String'(Spec (Spec'First .. Last) &
2169                                            Name_Buffer (1 .. Name_Len));
2170                         end if;
2171                      end;
2172                   end if;
2173                end if;
2174
2175                --  Add the directory of the spec as the destination directory
2176                --  of the body, if there is no destination directory already
2177                --  specified.
2178
2179                if File_Index /= 0 then
2180                   for Index in File_Index + 1 .. Last loop
2181                      if Last_Switches.Table (Index)
2182                          (Last_Switches.Table (Index)'First) /= '-'
2183                      then
2184                         Dir_Index := Index;
2185                         exit;
2186                      end if;
2187                   end loop;
2188
2189                   if Dir_Index = 0 then
2190                      Last_Switches.Increment_Last;
2191                      Last_Switches.Table (Last_Switches.Last) :=
2192                        new String'
2193                              (Dir_Name (Last_Switches.Table (File_Index).all));
2194                   end if;
2195                end if;
2196             end;
2197          end if;
2198
2199          --  For gnatmetric, the generated files should be put in the object
2200          --  directory. This must be the first switch, because it may be
2201          --  overridden by a switch in package Metrics in the project file or
2202          --  by a command line option. Note that we don't add the -d= switch
2203          --  if there is no object directory available.
2204
2205          if The_Command = Metric
2206            and then Project.Object_Directory /= No_Path_Information
2207          then
2208             First_Switches.Increment_Last;
2209             First_Switches.Table (2 .. First_Switches.Last) :=
2210               First_Switches.Table (1 .. First_Switches.Last - 1);
2211             First_Switches.Table (1) :=
2212               new String'("-d=" &
2213                           Get_Name_String (Project.Object_Directory.Name));
2214          end if;
2215
2216          --  For gnat check, -rules and the following switches need to be the
2217          --  last options. So, we move all these switches to table
2218          --  Rules_Switches.
2219
2220          if The_Command = Check then
2221             declare
2222                New_Last : Natural;
2223                --  Set to rank of options preceding "-rules"
2224
2225                In_Rules_Switches : Boolean;
2226                --  Set to True when options "-rules" is found
2227
2228             begin
2229                New_Last := First_Switches.Last;
2230                In_Rules_Switches := False;
2231
2232                for J in 1 .. First_Switches.Last loop
2233                   if In_Rules_Switches then
2234                      Add_To_Rules_Switches (First_Switches.Table (J));
2235
2236                   elsif First_Switches.Table (J).all = "-rules" then
2237                      New_Last := J - 1;
2238                      In_Rules_Switches := True;
2239                   end if;
2240                end loop;
2241
2242                if In_Rules_Switches then
2243                   First_Switches.Set_Last (New_Last);
2244                end if;
2245
2246                New_Last := Last_Switches.Last;
2247                In_Rules_Switches := False;
2248
2249                for J in 1 .. Last_Switches.Last loop
2250                   if In_Rules_Switches then
2251                      Add_To_Rules_Switches (Last_Switches.Table (J));
2252
2253                   elsif Last_Switches.Table (J).all = "-rules" then
2254                      New_Last := J - 1;
2255                      In_Rules_Switches := True;
2256                   end if;
2257                end loop;
2258
2259                if In_Rules_Switches then
2260                   Last_Switches.Set_Last (New_Last);
2261                end if;
2262             end;
2263          end if;
2264
2265          --  For gnat check, sync, metric or pretty with -U + a main, get the
2266          --  list of sources from the closure and add them to the arguments.
2267
2268          if ASIS_Main /= null then
2269             Get_Closure;
2270
2271             --  On VMS, set up the env var again for source dirs file. This is
2272             --  because the call to gnatmake has set this env var to another
2273             --  file that has now been deleted.
2274
2275             if Hostparm.OpenVMS then
2276
2277                --  First make sure that the recorded file names are empty
2278
2279                Prj.Env.Initialize (Project_Tree);
2280
2281                Prj.Env.Set_Ada_Paths
2282                  (Project, Project_Tree, Including_Libraries => False);
2283             end if;
2284
2285          --  For gnat check, gnat sync, gnat pretty, gnat metric, gnat list,
2286          --  and gnat stack, if no file has been put on the command line, call
2287          --  tool with all the sources of the main project.
2288
2289          elsif The_Command = Check  or else
2290                The_Command = Sync   or else
2291                The_Command = Pretty or else
2292                The_Command = Metric or else
2293                The_Command = List   or else
2294                The_Command = Stack
2295          then
2296             Check_Files;
2297          end if;
2298       end if;
2299
2300       --  Gather all the arguments and invoke the executable
2301
2302       declare
2303          The_Args : Argument_List
2304                       (1 .. First_Switches.Last +
2305                             Last_Switches.Last +
2306                             Carg_Switches.Last +
2307                             Rules_Switches.Last);
2308          Arg_Num  : Natural := 0;
2309
2310       begin
2311          for J in 1 .. First_Switches.Last loop
2312             Arg_Num := Arg_Num + 1;
2313             The_Args (Arg_Num) := First_Switches.Table (J);
2314          end loop;
2315
2316          for J in 1 .. Last_Switches.Last loop
2317             Arg_Num := Arg_Num + 1;
2318             The_Args (Arg_Num) := Last_Switches.Table (J);
2319          end loop;
2320
2321          for J in 1 .. Carg_Switches.Last loop
2322             Arg_Num := Arg_Num + 1;
2323             The_Args (Arg_Num) := Carg_Switches.Table (J);
2324          end loop;
2325
2326          for J in 1 .. Rules_Switches.Last loop
2327             Arg_Num := Arg_Num + 1;
2328             The_Args (Arg_Num) := Rules_Switches.Table (J);
2329          end loop;
2330
2331          --  If Display_Command is on, only display the generated command
2332
2333          if Display_Command then
2334             Put (Standard_Error, "generated command -->");
2335             Put (Standard_Error, Exec_Path.all);
2336
2337             for Arg in The_Args'Range loop
2338                Put (Standard_Error, " ");
2339                Put (Standard_Error, The_Args (Arg).all);
2340             end loop;
2341
2342             Put (Standard_Error, "<--");
2343             New_Line (Standard_Error);
2344             raise Normal_Exit;
2345          end if;
2346
2347          if Verbose_Mode then
2348             Output.Write_Str (Exec_Path.all);
2349
2350             for Arg in The_Args'Range loop
2351                Output.Write_Char (' ');
2352                Output.Write_Str (The_Args (Arg).all);
2353             end loop;
2354
2355             Output.Write_Eol;
2356          end if;
2357
2358          My_Exit_Status :=
2359            Exit_Status (Spawn (Exec_Path.all, The_Args));
2360          raise Normal_Exit;
2361       end;
2362    end;
2363
2364 exception
2365    when Error_Exit =>
2366       if not Keep_Temporary_Files then
2367          Prj.Env.Delete_All_Path_Files (Project_Tree);
2368          Delete_Temp_Config_Files;
2369       end if;
2370
2371       Set_Exit_Status (Failure);
2372
2373    when Normal_Exit =>
2374       if not Keep_Temporary_Files then
2375          Prj.Env.Delete_All_Path_Files (Project_Tree);
2376          Delete_Temp_Config_Files;
2377       end if;
2378
2379       --  Since GNATCmd is normally called from DCL (the VMS shell), it must
2380       --  return an understandable VMS exit status. However the exit status
2381       --  returned *to* GNATCmd is a Posix style code, so we test it and return
2382       --  just a simple success or failure on VMS.
2383
2384       if Hostparm.OpenVMS and then My_Exit_Status /= Success then
2385          Set_Exit_Status (Failure);
2386       else
2387          Set_Exit_Status (My_Exit_Status);
2388       end if;
2389 end GNATCmd;