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