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