gcc/ada/gnatcmd.adb

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