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 (Last_Switches.Table (Index).all'Length > 7
 493                      and then Last_Switches.Table (Index) (1 .. 7) = "-files=")
 494          then
 495             Add_Sources := False;
 496             exit;
 497          end if;
 498       end loop;
 499
 500       --  If all arguments are switches and there is no switch -files=, add the
 501       --  path names of all the sources of the main project.
 502
 503       if Add_Sources then
 504
 505          --  For gnatcheck, gnatpp, and gnatmetric, create a temporary file and
 506          --  put the list of sources in it. For gnatstack create a temporary
 507          --  file with the list of .ci files.
 508
 509          if The_Command = List or else The_Command = Stack then
 510             Tempdir.Create_Temp_File (FD, Temp_File_Name);
 511             Last_Switches.Increment_Last;
 512             Last_Switches.Table (Last_Switches.Last) :=
 513               new String'("-files=" & Get_Name_String (Temp_File_Name));
 514          end if;
 515
 516          declare
 517             Proj : Project_List;
 518
 519          begin
 520             --  Gnatstack needs to add the .ci file for the binder generated
 521             --  files corresponding to all of the library projects and main
 522             --  units belonging to the application.
 523
 524             if The_Command = Stack then
 525                Proj := Project_Tree.Projects;
 526                while Proj /= null loop
 527                   if Check_Project (Proj.Project, Project) then
 528                      declare
 529                         Main : String_List_Id;
 530
 531                      begin
 532                         --  Include binder generated files for main programs
 533
 534                         Main := Proj.Project.Mains;
 535                         while Main /= Nil_String loop
 536                            Add_To_Response_File
 537                              (Get_Name_String
 538                                 (Proj.Project.Object_Directory.Name) &
 539                               B_Start                                &
 540                               MLib.Fil.Ext_To
 541                                 (Get_Name_String
 542                                    (Project_Tree.Shared.String_Elements.Table
 543                                       (Main).Value),
 544                                  "ci"));
 545
 546                            --  When looking for the .ci file for a binder
 547                            --  generated file, look for both b~xxx and b__xxx
 548                            --  as gprbuild always uses b__ as the prefix of
 549                            --  such files.
 550
 551                            if not Is_Regular_File (Name_Buffer (1 .. Name_Len))
 552                            then
 553                               Add_To_Response_File
 554                                 (Get_Name_String
 555                                    (Proj.Project.Object_Directory.Name) &
 556                                  "b__"                                  &
 557                                  MLib.Fil.Ext_To
 558                                    (Get_Name_String
 559                                       (Project_Tree.Shared
 560                                        .String_Elements.Table (Main).Value),
 561                                     "ci"));
 562                            end if;
 563
 564                            Main := Project_Tree.Shared.String_Elements.Table
 565                                      (Main).Next;
 566                         end loop;
 567
 568                         if Proj.Project.Library then
 569
 570                            --  Include the .ci file for the binder generated
 571                            --  files that contains the initialization and
 572                            --  finalization of the library.
 573
 574                            Add_To_Response_File
 575                              (Get_Name_String
 576                                 (Proj.Project.Object_Directory.Name)      &
 577                               B_Start                                     &
 578                               Get_Name_String (Proj.Project.Library_Name) &
 579                               ".ci");
 580
 581                            --  When looking for the .ci file for a binder
 582                            --  generated file, look for both b~xxx and b__xxx
 583                            --  as gprbuild always uses b__ as the prefix of
 584                            --  such files.
 585
 586                            if not Is_Regular_File (Name_Buffer (1 .. Name_Len))
 587                            then
 588                               Add_To_Response_File
 589                                 (Get_Name_String
 590                                    (Proj.Project.Object_Directory.Name)      &
 591                                  "b__"                                       &
 592                                  Get_Name_String (Proj.Project.Library_Name) &
 593                                  ".ci");
 594                            end if;
 595                         end if;
 596                      end;
 597                   end if;
 598
 599                   Proj := Proj.Next;
 600                end loop;
 601             end if;
 602
 603             Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
 604             while Unit /= No_Unit_Index loop
 605
 606                --  For gnatls, we only need to put the library units, body or
 607                --  spec, but not the subunits.
 608
 609                if The_Command = List then
 610                   if Unit.File_Names (Impl) /= null
 611                     and then not Unit.File_Names (Impl).Locally_Removed
 612                   then
 613                      --  There is a body, check if it is for this project
 614
 615                      if All_Projects
 616                        or else Unit.File_Names (Impl).Project = Project
 617                      then
 618                         Subunit := False;
 619
 620                         if Unit.File_Names (Spec) = null
 621                           or else Unit.File_Names (Spec).Locally_Removed
 622                         then
 623                            --  We have a body with no spec: we need to check if
 624                            --  this is a subunit, because gnatls will complain
 625                            --  about subunits.
 626
 627                            declare
 628                               Src_Ind : constant Source_File_Index :=
 629                                           Sinput.P.Load_Project_File
 630                                             (Get_Name_String
 631                                               (Unit.File_Names
 632                                                 (Impl).Path.Name));
 633                            begin
 634                               Subunit :=
 635                                 Sinput.P.Source_File_Is_Subunit (Src_Ind);
 636                            end;
 637                         end if;
 638
 639                         if not Subunit then
 640                            Add_To_Response_File
 641                              (Get_Name_String
 642                                 (Unit.File_Names (Impl).Display_File),
 643                               Check_File => False);
 644                         end if;
 645                      end if;
 646
 647                   elsif Unit.File_Names (Spec) /= null
 648                     and then not Unit.File_Names (Spec).Locally_Removed
 649                   then
 650                      --  We have a spec with no body. Check if it is for this
 651                      --  project.
 652
 653                      if All_Projects or else
 654                         Unit.File_Names (Spec).Project = Project
 655                      then
 656                         Add_To_Response_File
 657                           (Get_Name_String
 658                              (Unit.File_Names (Spec).Display_File),
 659                            Check_File => False);
 660                      end if;
 661                   end if;
 662
 663                --  For gnatstack, we put the .ci files corresponding to the
 664                --  different units, including the binder generated files. We
 665                --  only need to do that for the library units, body or spec,
 666                --  but not the subunits.
 667
 668                elsif The_Command = Stack then
 669                   if Unit.File_Names (Impl) /= null
 670                     and then not Unit.File_Names (Impl).Locally_Removed
 671                   then
 672                      --  There is a body. Check if .ci files for this project
 673                      --  must be added.
 674
 675                      if Check_Project
 676                           (Unit.File_Names (Impl).Project, Project)
 677                      then
 678                         Subunit := False;
 679
 680                         if Unit.File_Names (Spec) = null
 681                           or else Unit.File_Names (Spec).Locally_Removed
 682                         then
 683                            --  We have a body with no spec: we need to check
 684                            --  if this is a subunit, because .ci files are not
 685                            --  generated for subunits.
 686
 687                            declare
 688                               Src_Ind : constant Source_File_Index :=
 689                                           Sinput.P.Load_Project_File
 690                                             (Get_Name_String
 691                                               (Unit.File_Names
 692                                                 (Impl).Path.Name));
 693                            begin
 694                               Subunit :=
 695                                 Sinput.P.Source_File_Is_Subunit (Src_Ind);
 696                            end;
 697                         end if;
 698
 699                         if not Subunit then
 700                            Add_To_Response_File
 701                              (Get_Name_String
 702                                 (Unit.File_Names
 703                                    (Impl).Project. Object_Directory.Name) &
 704                               MLib.Fil.Ext_To
 705                                 (Get_Name_String
 706                                    (Unit.File_Names (Impl).Display_File),
 707                                  "ci"));
 708                         end if;
 709                      end if;
 710
 711                   elsif Unit.File_Names (Spec) /= null
 712                     and then not Unit.File_Names (Spec).Locally_Removed
 713                   then
 714                      --  Spec with no body, check if it is for this project
 715
 716                      if Check_Project
 717                           (Unit.File_Names (Spec).Project, Project)
 718                      then
 719                         Add_To_Response_File
 720                           (Get_Name_String
 721                              (Unit.File_Names
 722                                 (Spec).Project. Object_Directory.Name) &
 723                            Dir_Separator                               &
 724                            MLib.Fil.Ext_To
 725                              (Get_Name_String (Unit.File_Names (Spec).File),
 726                               "ci"));
 727                      end if;
 728                   end if;
 729                end if;
 730
 731                Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
 732             end loop;
 733          end;
 734
 735          if FD /= Invalid_FD then
 736             Close (FD, Success);
 737
 738             if not Success then
 739                Osint.Fail ("disk full");
 740             end if;
 741          end if;
 742       end if;
 743    end Check_Files;
 744
 745    -------------------
 746    -- Check_Project --
 747    -------------------
 748
 749    function Check_Project
 750      (Project      : Project_Id;
 751       Root_Project : Project_Id) return Boolean
 752    is
 753    begin
 754       if Project = No_Project then
 755          return False;
 756
 757       elsif All_Projects or else Project = Root_Project then
 758          return True;
 759       end if;
 760
 761       return False;
 762    end Check_Project;
 763
 764    -------------------------------
 765    -- Check_Relative_Executable --
 766    -------------------------------
 767
 768    procedure Check_Relative_Executable (Name : in out String_Access) is
 769       Exec_File_Name : constant String := Name.all;
 770
 771    begin
 772       if not Is_Absolute_Path (Exec_File_Name) then
 773          for Index in Exec_File_Name'Range loop
 774             if Exec_File_Name (Index) = Directory_Separator then
 775                Fail ("relative executable (""" & Exec_File_Name
 776                      & """) with directory part not allowed "
 777                      & "when using project files");
 778             end if;
 779          end loop;
 780
 781          Get_Name_String (Project.Exec_Directory.Name);
 782
 783          if Name_Buffer (Name_Len) /= Directory_Separator then
 784             Name_Len := Name_Len + 1;
 785             Name_Buffer (Name_Len) := Directory_Separator;
 786          end if;
 787
 788          Name_Buffer (Name_Len + 1 ..
 789                         Name_Len + Exec_File_Name'Length) :=
 790            Exec_File_Name;
 791          Name_Len := Name_Len + Exec_File_Name'Length;
 792          Name := new String'(Name_Buffer (1 .. Name_Len));
 793       end if;
 794    end Check_Relative_Executable;
 795
 796    --------------------------------
 797    -- Configuration_Pragmas_File --
 798    --------------------------------
 799
 800    function Configuration_Pragmas_File return Path_Name_Type is
 801    begin
 802       Prj.Env.Create_Config_Pragmas_File (Project, Project_Tree);
 803       return Project.Config_File_Name;
 804    end Configuration_Pragmas_File;
 805
 806    ------------------------------
 807    -- Delete_Temp_Config_Files --
 808    ------------------------------
 809
 810    procedure Delete_Temp_Config_Files is
 811       Success : Boolean;
 812       Proj    : Project_List;
 813       pragma Warnings (Off, Success);
 814
 815    begin
 816       --  This should only be called if Keep_Temporary_Files is False
 817
 818       pragma Assert (not Keep_Temporary_Files);
 819
 820       if Project /= No_Project then
 821          Proj := Project_Tree.Projects;
 822          while Proj /= null loop
 823             if Proj.Project.Config_File_Temp then
 824                Delete_Temporary_File
 825                  (Project_Tree.Shared, Proj.Project.Config_File_Name);
 826             end if;
 827
 828             Proj := Proj.Next;
 829          end loop;
 830       end if;
 831
 832       --  If a temporary text file that contains a list of files for a tool
 833       --  has been created, delete this temporary file.
 834
 835       if Temp_File_Name /= No_Path then
 836          Delete_Temporary_File (Project_Tree.Shared, Temp_File_Name);
 837       end if;
 838    end Delete_Temp_Config_Files;
 839
 840    ---------------------------
 841    -- Ensure_Absolute_Path --
 842    ---------------------------
 843
 844    procedure Ensure_Absolute_Path
 845      (Switch : in out String_Access;
 846       Parent : String)
 847    is
 848    begin
 849       Makeutl.Ensure_Absolute_Path
 850         (Switch, Parent,
 851          Do_Fail              => Osint.Fail'Access,
 852          Including_Non_Switch => False,
 853          Including_RTS        => True);
 854    end Ensure_Absolute_Path;
 855
 856    ------------------
 857    -- Mapping_File --
 858    ------------------
 859
 860    function Mapping_File return Path_Name_Type is
 861       Result : Path_Name_Type;
 862    begin
 863       Prj.Env.Create_Mapping_File
 864         (Project  => Project,
 865          Language => Name_Ada,
 866          In_Tree  => Project_Tree,
 867          Name     => Result);
 868       return Result;
 869    end Mapping_File;
 870
 871    --------------------
 872    -- Output_Version --
 873    --------------------
 874
 875    procedure Output_Version is
 876    begin
 877       if AAMP_On_Target then
 878          Put ("GNAAMP ");
 879       else
 880          Put ("GNAT ");
 881       end if;
 882
 883       Put_Line (Gnatvsn.Gnat_Version_String);
 884       Put_Line ("Copyright 1996-" &
 885                 Gnatvsn.Current_Year &
 886                 ", Free Software Foundation, Inc.");
 887    end Output_Version;
 888
 889    -----------
 890    -- Usage --
 891    -----------
 892
 893    procedure Usage is
 894    begin
 895       Output_Version;
 896       New_Line;
 897       Put_Line ("List of available commands");
 898       New_Line;
 899
 900       for C in Command_List'Range loop
 901
 902          --  No usage for Sync
 903
 904          if C /= Sync then
 905             if Targparm.AAMP_On_Target then
 906                Put ("gnaampcmd ");
 907             else
 908                Put ("gnat ");
 909             end if;
 910
 911             Put (To_Lower (Command_List (C).Cname.all));
 912             Set_Col (25);
 913
 914             --  Never call gnatstack with a prefix
 915
 916             if C = Stack then
 917                Put (Command_List (C).Unixcmd.all);
 918             else
 919                Put (Program_Name (Command_List (C).Unixcmd.all, "gnat").all);
 920             end if;
 921
 922             declare
 923                Sws : Argument_List_Access renames Command_List (C).Unixsws;
 924             begin
 925                if Sws /= null then
 926                   for J in Sws'Range loop
 927                      Put (' ');
 928                      Put (Sws (J).all);
 929                   end loop;
 930                end if;
 931             end;
 932
 933             New_Line;
 934          end if;
 935       end loop;
 936
 937       New_Line;
 938       Put_Line ("All commands except chop, krunch and preprocess " &
 939                   "accept project file switches -vPx, -Pprj, -Xnam=val," &
 940                 "--subdirs= and -eL");
 941       New_Line;
 942    end Usage;
 943
 944    ------------------
 945    -- Process_Link --
 946    ------------------
 947
 948    procedure Process_Link is
 949       Look_For_Executable : Boolean := True;
 950       Libraries_Present   : Boolean := False;
 951       Path_Option         : constant String_Access :=
 952                               MLib.Linker_Library_Path_Option;
 953       Prj                 : Project_Id := Project;
 954       Arg                 : String_Access;
 955       Last                : Natural := 0;
 956       Skip_Executable     : Boolean := False;
 957
 958    begin
 959       --  Add the default search directories, to be able to find
 960       --  libgnat in call to MLib.Utl.Lib_Directory.
 961
 962       Add_Default_Search_Dirs;
 963
 964       Library_Paths.Set_Last (0);
 965
 966       --  Check if there are library project files
 967
 968       if MLib.Tgt.Support_For_Libraries /= None then
 969          Set_Libraries (Project, Project_Tree, Libraries_Present);
 970       end if;
 971
 972       --  If there are, add the necessary additional switches
 973
 974       if Libraries_Present then
 975
 976          --  Add -Wl,-rpath,<lib_dir>
 977
 978          --  If Path_Option is not null, create the switch ("-Wl,-rpath," or
 979          --  equivalent) with all the library dirs plus the standard GNAT
 980          --  library dir.
 981
 982          if Path_Option /= null then
 983             declare
 984                Option  : String_Access;
 985                Length  : Natural := Path_Option'Length;
 986                Current : Natural;
 987
 988             begin
 989                if MLib.Separate_Run_Path_Options then
 990
 991                   --  We are going to create one switch of the form
 992                   --  "-Wl,-rpath,dir_N" for each directory to consider.
 993
 994                   --  One switch for each library directory
 995
 996                   for Index in
 997                     Library_Paths.First .. Library_Paths.Last
 998                   loop
 999                      Last_Switches.Increment_Last;
1000                      Last_Switches.Table
1001                        (Last_Switches.Last) := new String'
1002                        (Path_Option.all &
1003                         Last_Switches.Table (Index).all);
1004                   end loop;
1005
1006                   --  One switch for the standard GNAT library dir
1007
1008                   Last_Switches.Increment_Last;
1009                   Last_Switches.Table
1010                     (Last_Switches.Last) := new String'
1011                     (Path_Option.all & MLib.Utl.Lib_Directory);
1012
1013                else
1014                   --  First, compute the exact length for the switch
1015
1016                   for Index in
1017                     Library_Paths.First .. Library_Paths.Last
1018                   loop
1019                      --  Add the length of the library dir plus one for the
1020                      --  directory separator.
1021
1022                      Length :=
1023                        Length +
1024                          Library_Paths.Table (Index)'Length + 1;
1025                   end loop;
1026
1027                   --  Finally, add the length of the standard GNAT library dir
1028
1029                   Length := Length + MLib.Utl.Lib_Directory'Length;
1030                   Option := new String (1 .. Length);
1031                   Option (1 .. Path_Option'Length) := Path_Option.all;
1032                   Current := Path_Option'Length;
1033
1034                   --  Put each library dir followed by a dir separator
1035
1036                   for Index in
1037                     Library_Paths.First .. Library_Paths.Last
1038                   loop
1039                      Option
1040                        (Current + 1 ..
1041                           Current +
1042                             Library_Paths.Table (Index)'Length) :=
1043                        Library_Paths.Table (Index).all;
1044                      Current :=
1045                        Current +
1046                          Library_Paths.Table (Index)'Length + 1;
1047                      Option (Current) := Path_Separator;
1048                   end loop;
1049
1050                   --  Finally put the standard GNAT library dir
1051
1052                   Option
1053                     (Current + 1 ..
1054                        Current + MLib.Utl.Lib_Directory'Length) :=
1055                       MLib.Utl.Lib_Directory;
1056
1057                   --  And add the switch to the last switches
1058
1059                   Last_Switches.Increment_Last;
1060                   Last_Switches.Table (Last_Switches.Last) :=
1061                     Option;
1062                end if;
1063             end;
1064          end if;
1065       end if;
1066
1067       --  Check if the first ALI file specified can be found, either in the
1068       --  object directory of the main project or in an object directory of a
1069       --  project file extended by the main project. If the ALI file can be
1070       --  found, replace its name with its absolute path.
1071
1072       Skip_Executable := False;
1073
1074       Switch_Loop : for J in 1 .. Last_Switches.Last loop
1075
1076          --  If we have an executable just reset the flag
1077
1078          if Skip_Executable then
1079             Skip_Executable := False;
1080
1081          --  If -o, set flag so that next switch is not processed
1082
1083          elsif Last_Switches.Table (J).all = "-o" then
1084             Skip_Executable := True;
1085
1086          --  Normal case
1087
1088          else
1089             declare
1090                Switch    : constant String :=
1091                              Last_Switches.Table (J).all;
1092                ALI_File  : constant String (1 .. Switch'Length + 4) :=
1093                              Switch & ".ali";
1094
1095                Test_Existence : Boolean := False;
1096
1097             begin
1098                Last := Switch'Length;
1099
1100                --  Skip real switches
1101
1102                if Switch'Length /= 0
1103                  and then Switch (Switch'First) /= '-'
1104                then
1105                   --  Append ".ali" if file name does not end with it
1106
1107                   if Switch'Length <= 4
1108                     or else Switch (Switch'Last - 3 .. Switch'Last) /= ".ali"
1109                   then
1110                      Last := ALI_File'Last;
1111                   end if;
1112
1113                   --  If file name includes directory information, stop if ALI
1114                   --  file exists.
1115
1116                   if Is_Absolute_Path (ALI_File (1 .. Last)) then
1117                      Test_Existence := True;
1118
1119                   else
1120                      for K in Switch'Range loop
1121                         if Is_Directory_Separator (Switch (K)) then
1122                            Test_Existence := True;
1123                            exit;
1124                         end if;
1125                      end loop;
1126                   end if;
1127
1128                   if Test_Existence then
1129                      if Is_Regular_File (ALI_File (1 .. Last)) then
1130                         exit Switch_Loop;
1131                      end if;
1132
1133                   --  Look in object directories if ALI file exists
1134
1135                   else
1136                      Project_Loop : loop
1137                         declare
1138                            Dir : constant String :=
1139                                    Get_Name_String (Prj.Object_Directory.Name);
1140                         begin
1141                            if Is_Regular_File
1142                                 (Dir &
1143                                  ALI_File (1 .. Last))
1144                            then
1145                               --  We have found the correct project, so we
1146                               --  replace the file with the absolute path.
1147
1148                               Last_Switches.Table (J) :=
1149                                 new String'(Dir & ALI_File (1 .. Last));
1150
1151                               --  And we are done
1152
1153                               exit Switch_Loop;
1154                            end if;
1155                         end;
1156
1157                         --  Go to the project being extended, if any
1158
1159                         Prj := Prj.Extends;
1160                         exit Project_Loop when Prj = No_Project;
1161                      end loop Project_Loop;
1162                   end if;
1163                end if;
1164             end;
1165          end if;
1166       end loop Switch_Loop;
1167
1168       --  If a relative path output file has been specified, we add the exec
1169       --  directory.
1170
1171       for J in reverse 1 .. Last_Switches.Last - 1 loop
1172          if Last_Switches.Table (J).all = "-o" then
1173             Check_Relative_Executable
1174               (Name => Last_Switches.Table (J + 1));
1175             Look_For_Executable := False;
1176             exit;
1177          end if;
1178       end loop;
1179
1180       if Look_For_Executable then
1181          for J in reverse 1 .. First_Switches.Last - 1 loop
1182             if First_Switches.Table (J).all = "-o" then
1183                Look_For_Executable := False;
1184                Check_Relative_Executable
1185                  (Name => First_Switches.Table (J + 1));
1186                exit;
1187             end if;
1188          end loop;
1189       end if;
1190
1191       --  If no executable is specified, then find the name of the first ALI
1192       --  file on the command line and issue a -o switch with the absolute path
1193       --  of the executable in the exec directory.
1194
1195       if Look_For_Executable then
1196          for J in 1 .. Last_Switches.Last loop
1197             Arg  := Last_Switches.Table (J);
1198             Last := 0;
1199
1200             if Arg'Length /= 0 and then Arg (Arg'First) /= '-' then
1201                if Arg'Length > 4
1202                  and then Arg (Arg'Last - 3 .. Arg'Last) = ".ali"
1203                then
1204                   Last := Arg'Last - 4;
1205
1206                elsif Is_Regular_File (Arg.all & ".ali") then
1207                   Last := Arg'Last;
1208                end if;
1209
1210                if Last /= 0 then
1211                   Last_Switches.Increment_Last;
1212                   Last_Switches.Table (Last_Switches.Last) :=
1213                     new String'("-o");
1214                   Get_Name_String (Project.Exec_Directory.Name);
1215                   Last_Switches.Increment_Last;
1216                   Last_Switches.Table (Last_Switches.Last) :=
1217                     new String'(Name_Buffer (1 .. Name_Len) &
1218                                 Executable_Name
1219                                   (Base_Name (Arg (Arg'First .. Last))));
1220                   exit;
1221                end if;
1222             end if;
1223          end loop;
1224       end if;
1225    end Process_Link;
1226
1227    ---------------------
1228    -- Set_Library_For --
1229    ---------------------
1230
1231    procedure Set_Library_For
1232      (Project           : Project_Id;
1233       Tree              : Project_Tree_Ref;
1234       Libraries_Present : in out Boolean)
1235    is
1236       pragma Unreferenced (Tree);
1237
1238       Path_Option : constant String_Access :=
1239                       MLib.Linker_Library_Path_Option;
1240
1241    begin
1242       --  Case of library project
1243
1244       if Project.Library then
1245          Libraries_Present := True;
1246
1247          --  Add the -L switch
1248
1249          Last_Switches.Increment_Last;
1250          Last_Switches.Table (Last_Switches.Last) :=
1251            new String'("-L" & Get_Name_String (Project.Library_Dir.Name));
1252
1253          --  Add the -l switch
1254
1255          Last_Switches.Increment_Last;
1256          Last_Switches.Table (Last_Switches.Last) :=
1257            new String'("-l" & Get_Name_String (Project.Library_Name));
1258
1259          --  Add the directory to table Library_Paths, to be processed later
1260          --  if library is not static and if Path_Option is not null.
1261
1262          if Project.Library_Kind /= Static
1263            and then Path_Option /= null
1264          then
1265             Library_Paths.Increment_Last;
1266             Library_Paths.Table (Library_Paths.Last) :=
1267               new String'(Get_Name_String (Project.Library_Dir.Name));
1268          end if;
1269       end if;
1270    end Set_Library_For;
1271
1272    procedure Check_Version_And_Help is
1273      new Check_Version_And_Help_G (Usage);
1274
1275 --  Start of processing for GNATCmd
1276
1277 begin
1278    --  All output from GNATCmd is debugging or error output: send to stderr
1279
1280    Set_Standard_Error;
1281
1282    --  Initializations
1283
1284    Csets.Initialize;
1285    Snames.Initialize;
1286    Stringt.Initialize;
1287
1288    Prj.Tree.Initialize (Root_Environment, Gnatmake_Flags);
1289
1290    Project_Node_Tree := new Project_Node_Tree_Data;
1291    Prj.Tree.Initialize (Project_Node_Tree);
1292
1293    Prj.Initialize (Project_Tree);
1294
1295    Last_Switches.Init;
1296    Last_Switches.Set_Last (0);
1297
1298    First_Switches.Init;
1299    First_Switches.Set_Last (0);
1300    Carg_Switches.Init;
1301    Carg_Switches.Set_Last (0);
1302    Rules_Switches.Init;
1303    Rules_Switches.Set_Last (0);
1304
1305    --  Set AAMP_On_Target from command name, for testing in Osint.Program_Name
1306    --  to handle the mapping of GNAAMP tool names. We don't extract it from
1307    --  system.ads, as there may be no default runtime.
1308
1309    Find_Program_Name;
1310    AAMP_On_Target := Name_Buffer (1 .. Name_Len) = "gnaampcmd";
1311
1312    --  Put the command line in environment variable GNAT_DRIVER_COMMAND_LINE,
1313    --  so that the spawned tool may know the way the GNAT driver was invoked.
1314
1315    Name_Len := 0;
1316    Add_Str_To_Name_Buffer (Command_Name);
1317
1318    for J in 1 .. Argument_Count loop
1319       Add_Char_To_Name_Buffer (' ');
1320       Add_Str_To_Name_Buffer (Argument (J));
1321    end loop;
1322
1323    Setenv ("GNAT_DRIVER_COMMAND_LINE", Name_Buffer (1 .. Name_Len));
1324
1325    --  Add the directory where the GNAT driver is invoked in front of the path,
1326    --  if the GNAT driver is invoked with directory information.
1327
1328    declare
1329       Command : constant String := Command_Name;
1330
1331    begin
1332       for Index in reverse Command'Range loop
1333          if Command (Index) = Directory_Separator then
1334             declare
1335                Absolute_Dir : constant String :=
1336                                 Normalize_Pathname
1337                                   (Command (Command'First .. Index));
1338
1339                PATH : constant String :=
1340                         Absolute_Dir & Path_Separator & Getenv ("PATH").all;
1341
1342             begin
1343                Setenv ("PATH", PATH);
1344             end;
1345
1346             exit;
1347          end if;
1348       end loop;
1349    end;
1350
1351    --  Scan the command line
1352
1353    --  First, scan to detect --version and/or --help
1354
1355    Check_Version_And_Help ("GNAT", "1996");
1356
1357    begin
1358       loop
1359          if Command_Arg <= Argument_Count
1360            and then Argument (Command_Arg) = "-v"
1361          then
1362             Verbose_Mode := True;
1363             Command_Arg := Command_Arg + 1;
1364
1365          elsif Command_Arg <= Argument_Count
1366            and then Argument (Command_Arg) = "-dn"
1367          then
1368             Keep_Temporary_Files := True;
1369             Command_Arg := Command_Arg + 1;
1370
1371          else
1372             exit;
1373          end if;
1374       end loop;
1375
1376       --  If there is no command, just output the usage
1377
1378       if Command_Arg > Argument_Count then
1379          Usage;
1380          return;
1381       end if;
1382
1383       The_Command := Real_Command_Type'Value (Argument (Command_Arg));
1384
1385    exception
1386       when Constraint_Error =>
1387
1388          --  Check if it is an alternate command
1389
1390          declare
1391             Alternate : Alternate_Command;
1392
1393          begin
1394             Alternate := Alternate_Command'Value
1395                            (Argument (Command_Arg));
1396             The_Command := Corresponding_To (Alternate);
1397
1398          exception
1399             when Constraint_Error =>
1400                Usage;
1401                Fail ("unknown command: " & Argument (Command_Arg));
1402          end;
1403    end;
1404
1405    --  Get the arguments from the command line and from the eventual
1406    --  argument file(s) specified on the command line.
1407
1408    for Arg in Command_Arg + 1 .. Argument_Count loop
1409       declare
1410          The_Arg : constant String := Argument (Arg);
1411
1412       begin
1413          --  Check if an argument file is specified
1414
1415          if The_Arg (The_Arg'First) = '@' then
1416             declare
1417                Arg_File : Ada.Text_IO.File_Type;
1418                Line     : String (1 .. 256);
1419                Last     : Natural;
1420
1421             begin
1422                --  Open the file and fail if the file cannot be found
1423
1424                begin
1425                   Open
1426                     (Arg_File, In_File,
1427                      The_Arg (The_Arg'First + 1 .. The_Arg'Last));
1428
1429                exception
1430                   when others =>
1431                      Put (Standard_Error, "Cannot open argument file """);
1432                      Put (Standard_Error,
1433                           The_Arg (The_Arg'First + 1 .. The_Arg'Last));
1434                      Put_Line (Standard_Error, """");
1435                      raise Error_Exit;
1436                end;
1437
1438                --  Read line by line and put the content of each non-
1439                --  empty line in the Last_Switches table.
1440
1441                while not End_Of_File (Arg_File) loop
1442                   Get_Line (Arg_File, Line, Last);
1443
1444                   if Last /= 0 then
1445                      Last_Switches.Increment_Last;
1446                      Last_Switches.Table (Last_Switches.Last) :=
1447                        new String'(Line (1 .. Last));
1448                   end if;
1449                end loop;
1450
1451                Close (Arg_File);
1452             end;
1453
1454          else
1455             --  It is not an argument file; just put the argument in
1456             --  the Last_Switches table.
1457
1458             Last_Switches.Increment_Last;
1459             Last_Switches.Table (Last_Switches.Last) :=
1460               new String'(The_Arg);
1461          end if;
1462       end;
1463    end loop;
1464
1465    declare
1466       Program   : String_Access;
1467       Exec_Path : String_Access;
1468
1469    begin
1470       if The_Command = Stack then
1471
1472          --  Never call gnatstack with a prefix
1473
1474          Program := new String'(Command_List (The_Command).Unixcmd.all);
1475
1476       else
1477          Program :=
1478            Program_Name (Command_List (The_Command).Unixcmd.all, "gnat");
1479       end if;
1480
1481       --  For the tools where the GNAT driver processes the project files,
1482       --  allow shared library projects to import projects that are not shared
1483       --  library projects, to avoid adding a switch for these tools. For the
1484       --  builder (gnatmake), if a shared library project imports a project
1485       --  that is not a shared library project and the appropriate switch is
1486       --  not specified, the invocation of gnatmake will fail.
1487
1488       Opt.Unchecked_Shared_Lib_Imports := True;
1489
1490       --  Locate the executable for the command
1491
1492       Exec_Path := Locate_Exec_On_Path (Program.all);
1493
1494       if Exec_Path = null then
1495          Put_Line (Standard_Error, "could not locate " & Program.all);
1496          raise Error_Exit;
1497       end if;
1498
1499       --  If there are switches for the executable, put them as first switches
1500
1501       if Command_List (The_Command).Unixsws /= null then
1502          for J in Command_List (The_Command).Unixsws'Range loop
1503             First_Switches.Increment_Last;
1504             First_Switches.Table (First_Switches.Last) :=
1505               Command_List (The_Command).Unixsws (J);
1506          end loop;
1507       end if;
1508
1509       --  For BIND, CHECK, ELIM, FIND, LINK, LIST, METRIC, PRETTY, STACK, STUB,
1510       --  SYNC and XREF, look for project file related switches.
1511
1512       case The_Command is
1513          when Bind =>
1514             Tool_Package_Name := Name_Binder;
1515             Packages_To_Check := Packages_To_Check_By_Binder;
1516          when Find =>
1517             Tool_Package_Name := Name_Finder;
1518             Packages_To_Check := Packages_To_Check_By_Finder;
1519          when Link =>
1520             Tool_Package_Name := Name_Linker;
1521             Packages_To_Check := Packages_To_Check_By_Linker;
1522          when List =>
1523             Tool_Package_Name := Name_Gnatls;
1524             Packages_To_Check := Packages_To_Check_By_Gnatls;
1525          when Stack =>
1526             Tool_Package_Name := Name_Stack;
1527             Packages_To_Check := Packages_To_Check_By_Stack;
1528          when Sync =>
1529             Tool_Package_Name := Name_Synchronize;
1530             Packages_To_Check := Packages_To_Check_By_Sync;
1531          when Xref =>
1532             Tool_Package_Name := Name_Cross_Reference;
1533             Packages_To_Check := Packages_To_Check_By_Xref;
1534          when others =>
1535             Tool_Package_Name := No_Name;
1536       end case;
1537
1538       if Tool_Package_Name /= No_Name then
1539
1540          --  Check that the switches are consistent. Detect project file
1541          --  related switches.
1542
1543          Inspect_Switches : declare
1544             Arg_Num : Positive := 1;
1545             Argv    : String_Access;
1546
1547             procedure Remove_Switch (Num : Positive);
1548             --  Remove a project related switch from table Last_Switches
1549
1550             -------------------
1551             -- Remove_Switch --
1552             -------------------
1553
1554             procedure Remove_Switch (Num : Positive) is
1555             begin
1556                Last_Switches.Table (Num .. Last_Switches.Last - 1) :=
1557                  Last_Switches.Table (Num + 1 .. Last_Switches.Last);
1558                Last_Switches.Decrement_Last;
1559             end Remove_Switch;
1560
1561          --  Start of processing for Inspect_Switches
1562
1563          begin
1564             while Arg_Num <= Last_Switches.Last loop
1565                Argv := Last_Switches.Table (Arg_Num);
1566
1567                if Argv (Argv'First) = '-' then
1568                   if Argv'Length = 1 then
1569                      Fail
1570                        ("switch character cannot be followed by a blank");
1571                   end if;
1572
1573                   --  The two style project files (-p and -P) cannot be used
1574                   --  together
1575
1576                   if (The_Command = Find or else The_Command = Xref)
1577                     and then Argv (2) = 'p'
1578                   then
1579                      Old_Project_File_Used := True;
1580                      if Project_File /= null then
1581                         Fail ("-P and -p cannot be used together");
1582                      end if;
1583                   end if;
1584
1585                   --  --subdirs=... Specify Subdirs
1586
1587                   if Argv'Length > Makeutl.Subdirs_Option'Length
1588                     and then
1589                       Argv
1590                        (Argv'First ..
1591                         Argv'First + Makeutl.Subdirs_Option'Length - 1) =
1592                           Makeutl.Subdirs_Option
1593                   then
1594                      Subdirs :=
1595                        new String'
1596                          (Argv
1597                            (Argv'First + Makeutl.Subdirs_Option'Length ..
1598                             Argv'Last));
1599
1600                      Remove_Switch (Arg_Num);
1601
1602                   --  -aPdir  Add dir to the project search path
1603
1604                   elsif Argv'Length > 3
1605                     and then Argv (Argv'First + 1 .. Argv'First + 2) = "aP"
1606                   then
1607                      Prj.Env.Add_Directories
1608                        (Root_Environment.Project_Path,
1609                         Argv (Argv'First + 3 .. Argv'Last));
1610
1611                      --  Pass -aPdir to gnatls, but not to other tools
1612
1613                      if The_Command = List then
1614                         Arg_Num := Arg_Num + 1;
1615                      else
1616                         Remove_Switch (Arg_Num);
1617                      end if;
1618
1619                   --  -eL  Follow links for files
1620
1621                   elsif Argv.all = "-eL" then
1622                      Follow_Links_For_Files := True;
1623                      Follow_Links_For_Dirs  := True;
1624
1625                      Remove_Switch (Arg_Num);
1626
1627                   --  -vPx  Specify verbosity while parsing project files
1628
1629                   elsif Argv'Length >= 3
1630                     and then  Argv (Argv'First + 1 .. Argv'First + 2) = "vP"
1631                   then
1632                      if Argv'Length = 4
1633                           and then Argv (Argv'Last) in '0' .. '2'
1634                      then
1635                         case Argv (Argv'Last) is
1636                            when '0' =>
1637                               Current_Verbosity := Prj.Default;
1638                            when '1' =>
1639                               Current_Verbosity := Prj.Medium;
1640                            when '2' =>
1641                               Current_Verbosity := Prj.High;
1642                            when others =>
1643
1644                               --  Cannot happen
1645
1646                               raise Program_Error;
1647                         end case;
1648                      else
1649                         Fail ("invalid verbosity level: "
1650                               & Argv (Argv'First + 3 .. Argv'Last));
1651                      end if;
1652
1653                      Remove_Switch (Arg_Num);
1654
1655                   --  -Pproject_file  Specify project file to be used
1656
1657                   elsif Argv (Argv'First + 1) = 'P' then
1658
1659                      --  Only one -P switch can be used
1660
1661                      if Project_File /= null then
1662                         Fail
1663                           (Argv.all
1664                            & ": second project file forbidden (first is """
1665                            & Project_File.all
1666                            & """)");
1667
1668                      --  The two style project files (-p and -P) cannot be
1669                      --  used together.
1670
1671                      elsif Old_Project_File_Used then
1672                         Fail ("-p and -P cannot be used together");
1673
1674                      elsif Argv'Length = 2 then
1675
1676                         --  There is space between -P and the project file
1677                         --  name. -P cannot be the last option.
1678
1679                         if Arg_Num = Last_Switches.Last then
1680                            Fail ("project file name missing after -P");
1681
1682                         else
1683                            Remove_Switch (Arg_Num);
1684                            Argv := Last_Switches.Table (Arg_Num);
1685
1686                            --  After -P, there must be a project file name,
1687                            --  not another switch.
1688
1689                            if Argv (Argv'First) = '-' then
1690                               Fail ("project file name missing after -P");
1691
1692                            else
1693                               Project_File := new String'(Argv.all);
1694                            end if;
1695                         end if;
1696
1697                      else
1698                         --  No space between -P and project file name
1699
1700                         Project_File :=
1701                           new String'(Argv (Argv'First + 2 .. Argv'Last));
1702                      end if;
1703
1704                      Remove_Switch (Arg_Num);
1705
1706                   --  -Xexternal=value Specify an external reference to be
1707                   --                   used in project files
1708
1709                   elsif Argv'Length >= 5
1710                     and then Argv (Argv'First + 1) = 'X'
1711                   then
1712                      if not Check (Root_Environment.External,
1713                                     Argv (Argv'First + 2 .. Argv'Last))
1714                      then
1715                         Fail (Argv.all
1716                               & " is not a valid external assignment.");
1717                      end if;
1718
1719                      Remove_Switch (Arg_Num);
1720
1721                   elsif
1722                     (The_Command = Sync   or else
1723                      The_Command = Stack  or else
1724                      The_Command = List)
1725                     and then Argv'Length = 2
1726                     and then Argv (2) = 'U'
1727                   then
1728                      All_Projects := True;
1729                      Remove_Switch (Arg_Num);
1730
1731                   else
1732                      Arg_Num := Arg_Num + 1;
1733                   end if;
1734
1735                else
1736                   Arg_Num := Arg_Num + 1;
1737                end if;
1738             end loop;
1739          end Inspect_Switches;
1740       end if;
1741
1742       --  Add the default project search directories now, after the directories
1743       --  that have been specified by switches -aP<dir>.
1744
1745       Prj.Env.Initialize_Default_Project_Path
1746         (Root_Environment.Project_Path,
1747          Target_Name => Sdefault.Target_Name.all);
1748
1749       --  If there is a project file specified, parse it, get the switches
1750       --  for the tool and setup PATH environment variables.
1751
1752       if Project_File /= null then
1753          Prj.Pars.Set_Verbosity (To => Current_Verbosity);
1754
1755          Prj.Pars.Parse
1756            (Project           => Project,
1757             In_Tree           => Project_Tree,
1758             In_Node_Tree      => Project_Node_Tree,
1759             Project_File_Name => Project_File.all,
1760             Env               => Root_Environment,
1761             Packages_To_Check => Packages_To_Check);
1762
1763          --  Prj.Pars.Parse calls Set_Standard_Output, reset to stderr
1764
1765          Set_Standard_Error;
1766
1767          if Project = Prj.No_Project then
1768             Fail ("""" & Project_File.all & """ processing failed");
1769
1770          elsif Project.Qualifier = Aggregate then
1771             Fail ("aggregate projects are not supported");
1772
1773          elsif Aggregate_Libraries_In (Project_Tree) then
1774             Fail ("aggregate library projects are not supported");
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                        Shared      => Project_Tree.Shared);
1786
1787             Element : Package_Element;
1788
1789             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             Main : String_Access := null;
1796
1797          begin
1798             if Pkg /= No_Package then
1799                Element := Project_Tree.Shared.Packages.Table (Pkg);
1800
1801                --  Packages Gnatls and Gnatstack have a single attribute
1802                --  Switches, that is not an associative array.
1803
1804                if The_Command = List or else The_Command = Stack then
1805                   The_Switches :=
1806                     Prj.Util.Value_Of
1807                     (Variable_Name => Snames.Name_Switches,
1808                      In_Variables  => Element.Decl.Attributes,
1809                      Shared        => Project_Tree.Shared);
1810
1811                --  Packages Binder (for gnatbind), Cross_Reference (for
1812                --  gnatxref), Linker (for gnatlink), Finder (for gnatfind),
1813                --  have an attributed Switches, an associative array, indexed
1814                --  by the 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                   --  First check if there is a single main
1821
1822                   for J in 1 .. Last_Switches.Last loop
1823                      if Last_Switches.Table (J) (1) /= '-' then
1824                         if Main = null then
1825                            Main := Last_Switches.Table (J);
1826
1827                         else
1828                            Main := null;
1829                            exit;
1830                         end if;
1831                      end if;
1832                   end loop;
1833
1834                   if Main /= null then
1835                      Switches_Array :=
1836                        Prj.Util.Value_Of
1837                          (Name      => Name_Switches,
1838                           In_Arrays => Element.Decl.Arrays,
1839                           Shared    => Project_Tree.Shared);
1840                      Name_Len := 0;
1841
1842                      --  If the single main has been specified as an absolute
1843                      --  path, use only the simple file name. If the absolute
1844                      --  path is incorrect, an error will be reported by the
1845                      --  underlying tool and it does not make a difference
1846                      --  what switches are used.
1847
1848                      if Is_Absolute_Path (Main.all) then
1849                         Add_Str_To_Name_Buffer (File_Name (Main.all));
1850                      else
1851                         Add_Str_To_Name_Buffer (Main.all);
1852                      end if;
1853
1854                      The_Switches := Prj.Util.Value_Of
1855                        (Index     => Name_Find,
1856                         Src_Index => 0,
1857                         In_Array  => Switches_Array,
1858                         Shared    => Project_Tree.Shared);
1859                   end if;
1860
1861                   if The_Switches.Kind = Prj.Undefined then
1862                      Switches_Array :=
1863                        Prj.Util.Value_Of
1864                          (Name      => Name_Default_Switches,
1865                           In_Arrays => Element.Decl.Arrays,
1866                           Shared    => Project_Tree.Shared);
1867                      The_Switches := Prj.Util.Value_Of
1868                        (Index     => Name_Ada,
1869                         Src_Index => 0,
1870                         In_Array  => Switches_Array,
1871                         Shared    => Project_Tree.Shared);
1872                   end if;
1873                end if;
1874
1875                --  If there are switches specified in the package of the
1876                --  project file corresponding to the tool, scan them.
1877
1878                case The_Switches.Kind is
1879                   when Prj.Undefined =>
1880                      null;
1881
1882                   when Prj.Single =>
1883                      declare
1884                         Switch : constant String :=
1885                                    Get_Name_String (The_Switches.Value);
1886
1887                      begin
1888                         if Switch'Length > 0 then
1889                            First_Switches.Increment_Last;
1890                            First_Switches.Table (First_Switches.Last) :=
1891                              new String'(Switch);
1892                         end if;
1893                      end;
1894
1895                   when Prj.List =>
1896                      Current := The_Switches.Values;
1897                      while Current /= Prj.Nil_String loop
1898                         The_String := Project_Tree.Shared.String_Elements.
1899                                         Table (Current);
1900
1901                         declare
1902                            Switch : constant String :=
1903                              Get_Name_String (The_String.Value);
1904
1905                         begin
1906                            if Switch'Length > 0 then
1907                               First_Switches.Increment_Last;
1908                               First_Switches.Table (First_Switches.Last) :=
1909                                 new String'(Switch);
1910                            end if;
1911                         end;
1912
1913                         Current := The_String.Next;
1914                      end loop;
1915                end case;
1916             end if;
1917          end;
1918
1919          if The_Command = Bind or else The_Command = Link then
1920             if Project.Object_Directory.Name = No_Path then
1921                Fail ("project " & Get_Name_String (Project.Display_Name)
1922                      & " has no object directory");
1923             end if;
1924
1925             Change_Dir (Get_Name_String (Project.Object_Directory.Name));
1926          end if;
1927
1928          --  Set up the env vars for project path files
1929
1930          Prj.Env.Set_Ada_Paths
1931            (Project, Project_Tree, Including_Libraries => True);
1932
1933          --  For gnatcheck, gnatstub, gnatmetric, gnatpp and gnatelim, create
1934          --  a configuration pragmas file, if necessary.
1935
1936          if The_Command = Sync then
1937
1938             --  If there are switches in package Compiler, put them in the
1939             --  Carg_Switches table.
1940
1941             declare
1942                Pkg  : constant Prj.Package_Id :=
1943                         Prj.Util.Value_Of
1944                           (Name        => Name_Compiler,
1945                            In_Packages => Project.Decl.Packages,
1946                            Shared      => Project_Tree.Shared);
1947
1948                Element : Package_Element;
1949
1950                Switches_Array : Array_Element_Id;
1951
1952                The_Switches : Prj.Variable_Value;
1953                Current      : Prj.String_List_Id;
1954                The_String   : String_Element;
1955
1956                Main    : String_Access := null;
1957                Main_Id : Name_Id;
1958
1959             begin
1960                if Pkg /= No_Package then
1961
1962                   --  First, check if there is a single main specified
1963
1964                   for J in 1  .. Last_Switches.Last loop
1965                      if Last_Switches.Table (J) (1) /= '-' then
1966                         if Main = null then
1967                            Main := Last_Switches.Table (J);
1968
1969                         else
1970                            Main := null;
1971                            exit;
1972                         end if;
1973                      end if;
1974                   end loop;
1975
1976                   Element := Project_Tree.Shared.Packages.Table (Pkg);
1977
1978                   --  If there is a single main and there is compilation
1979                   --  switches specified in the project file, use them.
1980
1981                   if Main /= null and then not All_Projects then
1982                      Name_Len := Main'Length;
1983                      Name_Buffer (1 .. Name_Len) := Main.all;
1984                      Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1985                      Main_Id := Name_Find;
1986
1987                      Switches_Array :=
1988                        Prj.Util.Value_Of
1989                          (Name      => Name_Switches,
1990                           In_Arrays => Element.Decl.Arrays,
1991                           Shared    => Project_Tree.Shared);
1992                      The_Switches := Prj.Util.Value_Of
1993                        (Index     => Main_Id,
1994                         Src_Index => 0,
1995                         In_Array  => Switches_Array,
1996                         Shared    => Project_Tree.Shared);
1997                   end if;
1998
1999                   --  Otherwise, get the Default_Switches ("Ada")
2000
2001                   if The_Switches.Kind = Undefined then
2002                      Switches_Array :=
2003                        Prj.Util.Value_Of
2004                          (Name      => Name_Default_Switches,
2005                           In_Arrays => Element.Decl.Arrays,
2006                           Shared    => Project_Tree.Shared);
2007                      The_Switches := Prj.Util.Value_Of
2008                        (Index     => Name_Ada,
2009                         Src_Index => 0,
2010                         In_Array  => Switches_Array,
2011                         Shared    => Project_Tree.Shared);
2012                   end if;
2013
2014                   --  If there are switches specified, put them in the
2015                   --  Carg_Switches table.
2016
2017                   case The_Switches.Kind is
2018                      when Prj.Undefined =>
2019                         null;
2020
2021                      when Prj.Single =>
2022                         declare
2023                            Switch : constant String :=
2024                                       Get_Name_String (The_Switches.Value);
2025                         begin
2026                            if Switch'Length > 0 then
2027                               Add_To_Carg_Switches (new String'(Switch));
2028                            end if;
2029                         end;
2030
2031                      when Prj.List =>
2032                         Current := The_Switches.Values;
2033                         while Current /= Prj.Nil_String loop
2034                            The_String := Project_Tree.Shared.String_Elements
2035                              .Table (Current);
2036
2037                            declare
2038                               Switch : constant String :=
2039                                          Get_Name_String (The_String.Value);
2040                            begin
2041                               if Switch'Length > 0 then
2042                                  Add_To_Carg_Switches (new String'(Switch));
2043                               end if;
2044                            end;
2045
2046                            Current := The_String.Next;
2047                         end loop;
2048                   end case;
2049                end if;
2050             end;
2051
2052             --  If -cargs is one of the switches, move the following switches
2053             --  to the Carg_Switches table.
2054
2055             for J in 1 .. First_Switches.Last loop
2056                if First_Switches.Table (J).all = "-cargs" then
2057                   declare
2058                      K    : Positive;
2059                      Last : Natural;
2060
2061                   begin
2062                      --  Move the switches that are before -rules when the
2063                      --  command is CHECK.
2064
2065                      K := J + 1;
2066                      while K <= First_Switches.Last loop
2067                         Add_To_Carg_Switches (First_Switches.Table (K));
2068                         K := K + 1;
2069                      end loop;
2070
2071                      if K > First_Switches.Last then
2072                         First_Switches.Set_Last (J - 1);
2073
2074                      else
2075                         Last := J - 1;
2076                         while K <= First_Switches.Last loop
2077                            Last := Last + 1;
2078                            First_Switches.Table (Last) :=
2079                              First_Switches.Table (K);
2080                            K := K + 1;
2081                         end loop;
2082
2083                         First_Switches.Set_Last (Last);
2084                      end if;
2085                   end;
2086
2087                   exit;
2088                end if;
2089             end loop;
2090
2091             for J in 1 .. Last_Switches.Last loop
2092                if Last_Switches.Table (J).all = "-cargs" then
2093                   for K in J + 1 .. Last_Switches.Last loop
2094                      Add_To_Carg_Switches (Last_Switches.Table (K));
2095                   end loop;
2096
2097                   Last_Switches.Set_Last (J - 1);
2098                   exit;
2099                end if;
2100             end loop;
2101
2102             declare
2103                CP_File : constant Path_Name_Type := Configuration_Pragmas_File;
2104                M_File  : constant Path_Name_Type := Mapping_File;
2105
2106             begin
2107                if CP_File /= No_Path then
2108                   Add_To_Carg_Switches
2109                     (new String'("-gnatec=" & Get_Name_String (CP_File)));
2110                end if;
2111
2112                if M_File /= No_Path then
2113                   Add_To_Carg_Switches
2114                     (new String'("-gnatem=" & Get_Name_String (M_File)));
2115                end if;
2116             end;
2117          end if;
2118
2119          if The_Command = Link then
2120             Process_Link;
2121          end if;
2122
2123          if The_Command = Link or else The_Command = Bind then
2124
2125             --  For files that are specified as relative paths with directory
2126             --  information, we convert them to absolute paths, with parent
2127             --  being the current working directory if specified on the command
2128             --  line and the project directory if specified in the project
2129             --  file. This is what gnatmake is doing for linker and binder
2130             --  arguments.
2131
2132             for J in 1 .. Last_Switches.Last loop
2133                GNATCmd.Ensure_Absolute_Path
2134                  (Last_Switches.Table (J), Current_Work_Dir);
2135             end loop;
2136
2137             Get_Name_String (Project.Directory.Name);
2138
2139             declare
2140                Project_Dir : constant String := Name_Buffer (1 .. Name_Len);
2141             begin
2142                for J in 1 .. First_Switches.Last loop
2143                   GNATCmd.Ensure_Absolute_Path
2144                     (First_Switches.Table (J), Project_Dir);
2145                end loop;
2146             end;
2147          end if;
2148
2149          --  For gnat sync with -U + a main, get the list of sources from the
2150          --  closure and add them to the arguments.
2151
2152          --  For gnat sync, gnat list, and gnat stack, if no file has been put
2153          --  on the command line, call tool with all the sources of the main
2154          --  project.
2155
2156          if The_Command = Sync  or else
2157             The_Command = List  or else
2158             The_Command = Stack
2159          then
2160             Check_Files;
2161          end if;
2162       end if;
2163
2164       --  Gather all the arguments and invoke the executable
2165
2166       declare
2167          The_Args : Argument_List
2168                       (1 .. First_Switches.Last +
2169                             Last_Switches.Last +
2170                             Carg_Switches.Last +
2171                             Rules_Switches.Last);
2172          Arg_Num  : Natural := 0;
2173
2174       begin
2175          for J in 1 .. First_Switches.Last loop
2176             Arg_Num := Arg_Num + 1;
2177             The_Args (Arg_Num) := First_Switches.Table (J);
2178          end loop;
2179
2180          for J in 1 .. Last_Switches.Last loop
2181             Arg_Num := Arg_Num + 1;
2182             The_Args (Arg_Num) := Last_Switches.Table (J);
2183          end loop;
2184
2185          for J in 1 .. Carg_Switches.Last loop
2186             Arg_Num := Arg_Num + 1;
2187             The_Args (Arg_Num) := Carg_Switches.Table (J);
2188          end loop;
2189
2190          for J in 1 .. Rules_Switches.Last loop
2191             Arg_Num := Arg_Num + 1;
2192             The_Args (Arg_Num) := Rules_Switches.Table (J);
2193          end loop;
2194
2195          if Verbose_Mode then
2196             Output.Write_Str (Exec_Path.all);
2197
2198             for Arg in The_Args'Range loop
2199                Output.Write_Char (' ');
2200                Output.Write_Str (The_Args (Arg).all);
2201             end loop;
2202
2203             Output.Write_Eol;
2204          end if;
2205
2206          My_Exit_Status :=
2207            Exit_Status (Spawn (Exec_Path.all, The_Args));
2208          raise Normal_Exit;
2209       end;
2210    end;
2211
2212 exception
2213    when Error_Exit =>
2214       if not Keep_Temporary_Files then
2215          Prj.Delete_All_Temp_Files (Project_Tree.Shared);
2216          Delete_Temp_Config_Files;
2217       end if;
2218
2219       Set_Exit_Status (Failure);
2220
2221    when Normal_Exit =>
2222       if not Keep_Temporary_Files then
2223          Prj.Delete_All_Temp_Files (Project_Tree.Shared);
2224          Delete_Temp_Config_Files;
2225       end if;
2226
2227       Set_Exit_Status (My_Exit_Status);
2228 end GNATCmd;