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