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