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