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