gcc/ada/gnatcmd.adb

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