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