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