gcc/ada/gnatcmd.adb

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