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