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