gcc/ada/gnatcmd.adb

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