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