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