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