gcc/ada/gnatcmd.adb

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