gcc/ada/makegpr.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              M A K E G P R                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2004-2007, 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 2,  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 COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with Csets;
  28 with Gnatvsn;
  29 with Hostparm; use Hostparm;
  30 with Makeutl;  use Makeutl;
  31 with MLib.Tgt; use MLib.Tgt;
  32 with Namet;    use Namet;
  33 with Output;   use Output;
  34 with Opt;      use Opt;
  35 with Osint;    use Osint;
  36 with Prj;      use Prj;
  37 with Prj.Ext;  use Prj.Ext;
  38 with Prj.Pars;
  39 with Prj.Util; use Prj.Util;
  40 with Snames;   use Snames;
  41 with Table;
  42 with Types;    use Types;
  43
  44 with Ada.Command_Line;           use Ada.Command_Line;
  45 with Ada.Strings.Fixed;          use Ada.Strings.Fixed;
  46 with Ada.Text_IO;                use Ada.Text_IO;
  47 with Ada.Unchecked_Deallocation;
  48
  49 with GNAT.Directory_Operations;  use GNAT.Directory_Operations;
  50 with GNAT.Dynamic_Tables;
  51 with GNAT.Expect;                use GNAT.Expect;
  52 with GNAT.HTable;
  53 with GNAT.OS_Lib;                use GNAT.OS_Lib;
  54 with GNAT.Regpat;                use GNAT.Regpat;
  55
  56 with System;
  57 with System.Case_Util;           use System.Case_Util;
  58
  59 package body Makegpr is
  60
  61    On_Windows : constant Boolean := Directory_Separator = '\';
  62    --  True when on Windows. Used in Check_Compilation_Needed when processing
  63    --  C/C++ dependency files for backslash handling.
  64
  65    Max_In_Archives : constant := 50;
  66    --  The maximum number of arguments for a single invocation of the
  67    --  Archive Indexer (ar).
  68
  69    No_Argument : aliased Argument_List := (1 .. 0 => null);
  70    --  Null argument list representing case of no arguments
  71
  72    FD : Process_Descriptor;
  73    --  The process descriptor used when invoking a non GNU compiler with -M
  74    --  and getting the output with GNAT.Expect.
  75
  76    Line_Matcher : constant Pattern_Matcher := Compile ("^.*?\n", Single_Line);
  77    --  Pattern for GNAT.Expect for the invocation of a non GNU compiler with -M
  78
  79    Name_Ide              : Name_Id;
  80    Name_Compiler_Command : Name_Id;
  81    --  Names of package IDE and its attribute Compiler_Command.
  82    --  Set up by Initialize.
  83
  84    Unique_Compile : Boolean := False;
  85    --  True when switch -u is used on the command line
  86
  87    type Source_Index_Rec is record
  88       Project : Project_Id;
  89       Id      : Other_Source_Id;
  90       Found   : Boolean := False;
  91    end record;
  92    --  Used as Source_Indexes component to check if archive needs to be rebuilt
  93
  94    type Source_Index_Array is array (Positive range <>) of Source_Index_Rec;
  95    type Source_Indexes_Ref is access Source_Index_Array;
  96
  97    procedure Free is new Ada.Unchecked_Deallocation
  98      (Source_Index_Array, Source_Indexes_Ref);
  99
 100    Initial_Source_Index_Count : constant Positive := 20;
 101    Source_Indexes : Source_Indexes_Ref :=
 102      new Source_Index_Array (1 .. Initial_Source_Index_Count);
 103    --  A list of the Other_Source_Ids of a project file, with an indication
 104    --  that they have been found in the archive dependency file.
 105
 106    Last_Source : Natural := 0;
 107    --  The index of the last valid component of Source_Indexes
 108
 109    Compiler_Names : array (First_Language_Indexes) of String_Access;
 110    --  The names of the compilers to be used. Set up by Get_Compiler.
 111    --  Used to display the commands spawned.
 112
 113    Gnatmake_String       : constant String_Access := new String'("gnatmake");
 114    GCC_String            : constant String_Access := new String'("gcc");
 115    G_Plus_Plus_String    : constant String_Access := new String'("g++");
 116
 117    Default_Compiler_Names : constant array
 118      (First_Language_Indexes range
 119         Ada_Language_Index .. C_Plus_Plus_Language_Index)
 120      of String_Access :=
 121        (Ada_Language_Index         => Gnatmake_String,
 122         C_Language_Index           => GCC_String,
 123         C_Plus_Plus_Language_Index => G_Plus_Plus_String);
 124
 125    Compiler_Paths : array (First_Language_Indexes) of String_Access;
 126    --  The path names of the compiler to be used. Set up by Get_Compiler.
 127    --  Used to spawn compiling/linking processes.
 128
 129    Compiler_Is_Gcc : array (First_Language_Indexes) of Boolean;
 130    --  An indication that a compiler is a GCC compiler, to be able to use
 131    --  specific GCC switches.
 132
 133    Archive_Builder_Path : String_Access := null;
 134    --  The path name of the archive builder (ar). To be used when spawning
 135    --  ar commands.
 136
 137    Archive_Indexer_Path : String_Access := null;
 138    --  The path name of the archive indexer (ranlib), if it exists
 139
 140    Copyright_Output : Boolean := False;
 141    Usage_Output     : Boolean := False;
 142    --  Flags to avoid multiple displays of Copyright notice and of Usage
 143
 144    Output_File_Name           : String_Access := null;
 145    --  The name given after a switch -o
 146
 147    Output_File_Name_Expected  : Boolean := False;
 148    --  True when last switch was -o
 149
 150    Project_File_Name          : String_Access := null;
 151    --  The name of the project file specified with switch -P
 152
 153    Project_File_Name_Expected : Boolean := False;
 154    --  True when last switch was -P
 155
 156    Naming_String   : aliased String := "naming";
 157    Builder_String  : aliased String := "builder";
 158    Compiler_String : aliased String := "compiler";
 159    Binder_String   : aliased String := "binder";
 160    Linker_String   : aliased String := "linker";
 161    --  Name of packages to be checked when parsing/processing project files
 162
 163    List_Of_Packages : aliased String_List :=
 164      (Naming_String   'Access,
 165       Builder_String  'Access,
 166       Compiler_String 'Access,
 167       Binder_String   'Access,
 168       Linker_String   'Access);
 169    Packages_To_Check : constant String_List_Access := List_Of_Packages'Access;
 170    --  List of the packages to be checked when parsing/processing project files
 171
 172    Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data;
 173
 174    Main_Project : Project_Id;
 175    --  The project id of the main project
 176
 177    type Processor is (None, Linker, Compiler);
 178    Current_Processor : Processor := None;
 179    --  This variable changes when switches -*args are used
 180
 181    Current_Language  : Language_Index := Ada_Language_Index;
 182    --  The compiler language to consider when Processor is Compiler
 183
 184    package Comp_Opts is new GNAT.Dynamic_Tables
 185      (Table_Component_Type => String_Access,
 186       Table_Index_Type     => Integer,
 187       Table_Low_Bound      => 1,
 188       Table_Initial        => 20,
 189       Table_Increment      => 100);
 190    Options : array (First_Language_Indexes) of Comp_Opts.Instance;
 191    --  Tables to store compiling options for the different compilers
 192
 193    package Linker_Options is new Table.Table
 194      (Table_Component_Type => String_Access,
 195       Table_Index_Type     => Integer,
 196       Table_Low_Bound      => 1,
 197       Table_Initial        => 20,
 198       Table_Increment      => 100,
 199       Table_Name           => "Makegpr.Linker_Options");
 200    --  Table to store the linking options
 201
 202    package Library_Opts is new Table.Table
 203      (Table_Component_Type => String_Access,
 204       Table_Index_Type     => Integer,
 205       Table_Low_Bound      => 1,
 206       Table_Initial        => 20,
 207       Table_Increment      => 100,
 208       Table_Name           => "Makegpr.Library_Opts");
 209    --  Table to store the linking options
 210
 211    package Ada_Mains is new Table.Table
 212      (Table_Component_Type => String_Access,
 213       Table_Index_Type     => Integer,
 214       Table_Low_Bound      => 1,
 215       Table_Initial        => 20,
 216       Table_Increment      => 100,
 217       Table_Name           => "Makegpr.Ada_Mains");
 218    --  Table to store the Ada mains, either specified on the command line
 219    --  or found in attribute Main of the main project file.
 220
 221    package Other_Mains is new Table.Table
 222      (Table_Component_Type => Other_Source,
 223       Table_Index_Type     => Integer,
 224       Table_Low_Bound      => 1,
 225       Table_Initial        => 20,
 226       Table_Increment      => 100,
 227       Table_Name           => "Makegpr.Other_Mains");
 228    --  Table to store the mains of languages other than Ada, either specified
 229    --  on the command line or found in attribute Main of the main project file.
 230
 231    package Sources_Compiled is new GNAT.HTable.Simple_HTable
 232      (Header_Num => Header_Num,
 233       Element    => Boolean,
 234       No_Element => False,
 235       Key        => File_Name_Type,
 236       Hash       => Hash,
 237       Equal      => "=");
 238
 239    package Saved_Switches is new Table.Table
 240      (Table_Component_Type => String_Access,
 241       Table_Index_Type     => Integer,
 242       Table_Low_Bound      => 1,
 243       Table_Initial        => 10,
 244       Table_Increment      => 100,
 245       Table_Name           => "Makegpr.Saved_Switches");
 246    --  Table to store the switches to be passed to gnatmake
 247
 248    Initial_Argument_Count : constant Positive := 20;
 249    type Boolean_Array is array (Positive range <>) of Boolean;
 250    type Booleans is access Boolean_Array;
 251
 252    procedure Free is new Ada.Unchecked_Deallocation (Boolean_Array, Booleans);
 253
 254    Arguments : Argument_List_Access :=
 255      new Argument_List (1 .. Initial_Argument_Count);
 256    --  Used to store lists of arguments to be used when spawning a process
 257
 258    Arguments_Displayed : Booleans :=
 259      new Boolean_Array (1 .. Initial_Argument_Count);
 260    --  For each argument in Arguments, indicate if the argument should be
 261    --  displayed when procedure Display_Command is called.
 262
 263    Last_Argument : Natural := 0;
 264    --  Index of the last valid argument in Arguments
 265
 266    package Cache_Args is new Table.Table
 267      (Table_Component_Type => String_Access,
 268       Table_Index_Type     => Integer,
 269       Table_Low_Bound      => 1,
 270       Table_Initial        => 200,
 271       Table_Increment      => 100,
 272       Table_Name           => "Makegpr.Cache_Args");
 273    --  A table to cache arguments, to avoid multiple allocation of the same
 274    --  strings. It is not possible to use a hash table, because String is
 275    --  an unconstrained type.
 276
 277    --  Various switches used when spawning processes:
 278
 279    Dash_B_String     : aliased  String := "-B";
 280    Dash_B            : constant String_Access := Dash_B_String'Access;
 281    Dash_c_String     : aliased  String := "-c";
 282    Dash_c            : constant String_Access := Dash_c_String'Access;
 283    Dash_cargs_String : aliased  String := "-cargs";
 284    Dash_cargs        : constant String_Access := Dash_cargs_String'Access;
 285    Dash_d_String     : aliased  String := "-d";
 286    Dash_d            : constant String_Access := Dash_d_String'Access;
 287    Dash_f_String     : aliased  String := "-f";
 288    Dash_f            : constant String_Access := Dash_f_String'Access;
 289    Dash_k_String     : aliased  String := "-k";
 290    Dash_k            : constant String_Access := Dash_k_String'Access;
 291    Dash_largs_String : aliased  String := "-largs";
 292    Dash_largs        : constant String_Access := Dash_largs_String'Access;
 293    Dash_M_String     : aliased  String := "-M";
 294    Dash_M            : constant String_Access := Dash_M_String'Access;
 295    Dash_margs_String : aliased  String := "-margs";
 296    Dash_margs        : constant String_Access := Dash_margs_String'Access;
 297    Dash_o_String     : aliased  String := "-o";
 298    Dash_o            : constant String_Access := Dash_o_String'Access;
 299    Dash_P_String     : aliased  String := "-P";
 300    Dash_P            : constant String_Access := Dash_P_String'Access;
 301    Dash_q_String     : aliased  String := "-q";
 302    Dash_q            : constant String_Access := Dash_q_String'Access;
 303    Dash_u_String     : aliased  String := "-u";
 304    Dash_u            : constant String_Access := Dash_u_String'Access;
 305    Dash_v_String     : aliased  String := "-v";
 306    Dash_v            : constant String_Access := Dash_v_String'Access;
 307    Dash_vP1_String   : aliased  String := "-vP1";
 308    Dash_vP1          : constant String_Access := Dash_vP1_String'Access;
 309    Dash_vP2_String   : aliased  String := "-vP2";
 310    Dash_vP2          : constant String_Access := Dash_vP2_String'Access;
 311    Dash_x_String     : aliased  String := "-x";
 312    Dash_x            : constant String_Access := Dash_x_String'Access;
 313    r_String          : aliased  String := "r";
 314    r                 : constant String_Access := r_String'Access;
 315
 316    CPATH : constant String := "CPATH";
 317    --  The environment variable to set when compiler is a GCC compiler
 318    --  to indicate the include directory path.
 319
 320    Current_Include_Paths : array (First_Language_Indexes) of String_Access;
 321    --  A cache for the paths of included directories, to avoid setting
 322    --  env var CPATH unnecessarily.
 323
 324    C_Plus_Plus_Is_Used : Boolean := False;
 325    --  True when there are sources in C++
 326
 327    Link_Options_Switches : Argument_List_Access := null;
 328    --  The link options coming from the attributes Linker'Linker_Options in
 329    --  project files imported, directly or indirectly, by the main project.
 330
 331    Total_Number_Of_Errors : Natural := 0;
 332    --  Used when Keep_Going is True (switch -k) to keep the total number
 333    --  of compilation/linking errors, to report at the end of execution.
 334
 335    Need_To_Rebuild_Global_Archive : Boolean := False;
 336
 337    Error_Header : constant String := "*** ERROR: ";
 338    --  The beginning of error message, when Keep_Going is True
 339
 340    Need_To_Relink : Boolean := False;
 341    --  True when an executable of a language other than Ada need to be linked
 342
 343    Global_Archive_Exists : Boolean := False;
 344    --  True if there is a non empty global archive, to prevent creation
 345    --  of such archives.
 346
 347    Path_Option : String_Access;
 348    --  The path option switch, when supported
 349
 350    Project_Of_Current_Object_Directory : Project_Id := No_Project;
 351    --  The object directory of the project for the last compilation. Avoid
 352    --  calling Change_Dir if the current working directory is already this
 353    --  directory.
 354
 355    package Lib_Path is new Table.Table
 356      (Table_Component_Type => Character,
 357       Table_Index_Type     => Integer,
 358       Table_Low_Bound      => 1,
 359       Table_Initial        => 200,
 360       Table_Increment      => 100,
 361       Table_Name           => "Makegpr.Lib_Path");
 362    --  A table to compute the path to put in the path option switch, when it
 363    --  is supported.
 364
 365    procedure Add_Archives (For_Gnatmake : Boolean);
 366    --  Add to Arguments the list of archives for linking an executable
 367
 368    procedure Add_Argument (Arg : String_Access; Display : Boolean);
 369    procedure Add_Argument (Arg : String; Display : Boolean);
 370    --  Add an argument to Arguments. Reallocate if necessary
 371
 372    procedure Add_Arguments (Args : Argument_List; Display : Boolean);
 373    --  Add a list of arguments to Arguments. Reallocate if necessary
 374
 375    procedure Add_Option (Arg : String);
 376    --  Add a switch for the Ada, C or C++ compiler, or for the linker.
 377    --  The table where this option is stored depends on the values of
 378    --  Current_Processor and Current_Language.
 379
 380    procedure Add_Search_Directories
 381      (Data     : Project_Data;
 382       Language : First_Language_Indexes);
 383    --  Either add to the Arguments the necessary -I switches needed to
 384    --  compile, or, when compiler is gcc/g++, set up the C*INCLUDE_PATH
 385    --  environment variable, if necessary.
 386
 387    procedure Add_Source_Id (Project : Project_Id; Id : Other_Source_Id);
 388    --  Add a source id to Source_Indexes, with Found set to False
 389
 390    procedure Add_Switches
 391      (Data      : Project_Data;
 392       Proc      : Processor;
 393       Language  : Language_Index;
 394       File_Name : File_Name_Type);
 395    --  Add to Arguments the switches, if any, for a source (attribute Switches)
 396    --  or language (attribute Default_Switches), coming from package Compiler
 397    --  or Linker (depending on Proc) of a specified project file.
 398
 399    procedure Build_Global_Archive;
 400    --  Build the archive for the main project
 401
 402    procedure Build_Library (Project : Project_Id; Unconditionally : Boolean);
 403    --  Build the library for a library project. If Unconditionally is
 404    --  False, first check if the library is up to date, and build it only
 405    --  if it is not.
 406
 407    procedure Check (Option : String);
 408    --  Check that a switch coming from a project file is not the concatenation
 409    --  of several valid switch, for example "-g -v". If it is, issue a warning.
 410
 411    procedure Check_Archive_Builder;
 412    --  Check if the archive builder (ar) is there
 413
 414    procedure Check_Compilation_Needed
 415      (Source          : Other_Source;
 416       Need_To_Compile : out Boolean);
 417    --  Check if a source of a language other than Ada needs to be compiled or
 418    --  recompiled.
 419
 420    procedure Check_For_C_Plus_Plus;
 421    --  Check if C++ is used in at least one project
 422
 423    procedure Compile
 424      (Source_Id    : Other_Source_Id;
 425       Data         : Project_Data;
 426       Local_Errors : in out Boolean);
 427    --  Compile one non-Ada source
 428
 429    procedure Compile_Individual_Sources;
 430    --  Compile the sources specified on the command line, when in
 431    --  Unique_Compile mode.
 432
 433    procedure Compile_Link_With_Gnatmake (Mains_Specified : Boolean);
 434    --  Compile/Link with gnatmake when there are Ada sources in the main
 435    --  project. Arguments may already contain options to be used by
 436    --  gnatmake. Used for both Ada mains and mains of other languages.
 437    --  When Compile_Only is True, do not use the linking options
 438
 439    procedure Compile_Sources;
 440    --  Compile the sources of languages other than Ada, if necessary
 441
 442    procedure Copyright;
 443    --  Output the Copyright notice
 444
 445    procedure Create_Archive_Dependency_File
 446      (Name         : String;
 447       First_Source : Other_Source_Id);
 448    --  Create the archive dependency file for a library project
 449
 450    procedure Create_Global_Archive_Dependency_File (Name : String);
 451    --  Create the archive depenency file for the main project
 452
 453    procedure Display_Command
 454      (Name    : String;
 455       Path    : String_Access;
 456       CPATH   : String_Access := null;
 457       Ellipse : Boolean := False);
 458    --  Display the command for a spawned process, if in Verbose_Mode or not in
 459    --  Quiet_Output. In non verbose mode, when Ellipse is True, display "..."
 460    --  in place of the first argument that has Display set to False.
 461
 462    procedure Get_Compiler (For_Language : First_Language_Indexes);
 463    --  Find the compiler name and path name for a specified programming
 464    --  language, if not already done. Results are in the corresponding elements
 465    --  of arrays Compiler_Names and Compiler_Paths. Name of compiler is found
 466    --  in package IDE of the main project, or defaulted. Fail if compiler
 467    --  cannot be found on the path. For the Ada language, gnatmake, rather than
 468    --  the Ada compiler is returned.
 469
 470    procedure Get_Imported_Directories
 471      (Project : Project_Id;
 472       Data    : in out Project_Data);
 473    --  Find the necessary switches -I to be used when compiling sources of
 474    --  languages other than Ada, in a specified project file. Cache the result
 475    --  in component Imported_Directories_Switches of the project data. For
 476    --  gcc/g++ compilers, get the value of the C*_INCLUDE_PATH, instead.
 477
 478    procedure Initialize;
 479    --  Do the necessary package initialization and process the command line
 480    --  arguments.
 481
 482    function Is_Included_In_Global_Archive
 483      (Object_Name : File_Name_Type;
 484       Project     : Project_Id) return Boolean;
 485    --  Return True if the object Object_Name is not overridden by a source
 486    --  in a project extending project Project.
 487
 488    procedure Link_Executables;
 489    --  Link executables
 490
 491    procedure Report_Error (S1 : String; S2 : String := ""; S3 : String := "");
 492    --  Report an error. If Keep_Going is False, just call Osint.Fail. If
 493    --  Keep_Going is True, display the error and increase the total number of
 494    --  errors.
 495
 496    procedure Report_Total_Errors (Kind : String);
 497    --  If Total_Number_Of_Errors is not zero, report it, and fail
 498
 499    procedure Scan_Arg (Arg : String);
 500    --  Process one command line argument
 501
 502    function Strip_CR_LF (Text : String) return String;
 503    --  Remove characters ASCII.CR and ASCII.LF from a String
 504
 505    procedure Usage;
 506    --  Display the usage
 507
 508    ------------------
 509    -- Add_Archives --
 510    ------------------
 511
 512    procedure Add_Archives (For_Gnatmake : Boolean) is
 513       Last_Arg : constant Natural := Last_Argument;
 514       --  The position of the last argument before adding the archives. Used to
 515       --  reverse the order of the arguments added when processing the
 516       --  archives.
 517
 518       procedure Recursive_Add_Archives (Project : Project_Id);
 519       --  Recursive procedure to add the archive of a project file, if any,
 520       --  then call itself for the project imported.
 521
 522       ----------------------------
 523       -- Recursive_Add_Archives --
 524       ----------------------------
 525
 526       procedure Recursive_Add_Archives (Project : Project_Id) is
 527          Data     : Project_Data;
 528          Imported : Project_List;
 529          Prj      : Project_Id;
 530
 531          procedure Add_Archive_Path;
 532          --  For a library project or the main project, add the archive
 533          --  path to the arguments.
 534
 535          ----------------------
 536          -- Add_Archive_Path --
 537          ----------------------
 538
 539          procedure Add_Archive_Path is
 540             Increment : Positive;
 541             Prev_Last : Positive;
 542
 543          begin
 544             if Data.Library then
 545
 546                --  If it is a library project file, nothing to do if gnatmake
 547                --  will be invoked, because gnatmake will take care of it, even
 548                --  if the library is not an Ada library.
 549
 550                if not For_Gnatmake then
 551                   if Data.Library_Kind = Static then
 552                      Add_Argument
 553                        (Get_Name_String (Data.Display_Library_Dir) &
 554                         Directory_Separator &
 555                         "lib" & Get_Name_String (Data.Library_Name) &
 556                         '.' & Archive_Ext,
 557                         Verbose_Mode);
 558
 559                   else
 560                      --  As we first insert in the reverse order,
 561                      --  -L<dir> is put after -l<lib>
 562
 563                      Add_Argument
 564                        ("-l" & Get_Name_String (Data.Library_Name),
 565                         Verbose_Mode);
 566
 567                      Get_Name_String (Data.Display_Library_Dir);
 568
 569                      Add_Argument
 570                        ("-L" & Name_Buffer (1 .. Name_Len),
 571                         Verbose_Mode);
 572
 573                      --  If there is a run path option, prepend this directory
 574                      --  to the library path. It is probable that the order of
 575                      --  the directories in the path option is not important,
 576                      --  but just in case put the directories in the same order
 577                      --  as the libraries.
 578
 579                      if Path_Option /= null then
 580
 581                         --  If it is not the first directory, make room at the
 582                         --  beginning of the table, including for a path
 583                         --  separator.
 584
 585                         if Lib_Path.Last > 0 then
 586                            Increment := Name_Len + 1;
 587                            Prev_Last := Lib_Path.Last;
 588                            Lib_Path.Set_Last (Prev_Last + Increment);
 589
 590                            for Index in reverse 1 .. Prev_Last loop
 591                               Lib_Path.Table (Index + Increment) :=
 592                                 Lib_Path.Table (Index);
 593                            end loop;
 594
 595                            Lib_Path.Table (Increment) := Path_Separator;
 596
 597                         else
 598                            --  If it is the first directory, just set
 599                            --  Last to the length of the directory.
 600
 601                            Lib_Path.Set_Last (Name_Len);
 602                         end if;
 603
 604                         --  Put the directory at the beginning of the
 605                         --  table.
 606
 607                         for Index in 1 .. Name_Len loop
 608                            Lib_Path.Table (Index) := Name_Buffer (Index);
 609                         end loop;
 610                      end if;
 611                   end if;
 612                end if;
 613
 614             --  For a non-library project, the only archive needed is the one
 615             --  for the main project, if there is one.
 616
 617             elsif Project = Main_Project and then Global_Archive_Exists then
 618                Add_Argument
 619                  (Get_Name_String (Data.Display_Object_Dir) &
 620                   Directory_Separator &
 621                   "lib" & Get_Name_String (Data.Display_Name)
 622                   & '.' & Archive_Ext,
 623                   Verbose_Mode);
 624             end if;
 625          end Add_Archive_Path;
 626
 627       begin
 628          --  Nothing to do when there is no project specified
 629
 630          if Project /= No_Project then
 631             Data := Project_Tree.Projects.Table (Project);
 632
 633             --  Nothing to do if the project has already been processed
 634
 635             if not Data.Seen then
 636
 637                --  Mark the project as processed, to avoid processing it again
 638
 639                Project_Tree.Projects.Table (Project).Seen := True;
 640
 641                Recursive_Add_Archives (Data.Extends);
 642
 643                Imported := Data.Imported_Projects;
 644
 645                --  Call itself recursively for all imported projects
 646
 647                while Imported /= Empty_Project_List loop
 648                   Prj := Project_Tree.Project_Lists.Table
 649                            (Imported).Project;
 650
 651                   if Prj /= No_Project then
 652                      while Project_Tree.Projects.Table
 653                              (Prj).Extended_By /= No_Project
 654                      loop
 655                         Prj := Project_Tree.Projects.Table
 656                                  (Prj).Extended_By;
 657                      end loop;
 658
 659                      Recursive_Add_Archives (Prj);
 660                   end if;
 661
 662                   Imported := Project_Tree.Project_Lists.Table
 663                                 (Imported).Next;
 664                end loop;
 665
 666                --  If there is sources of language other than Ada in this
 667                --  project, add the path of the archive to Arguments.
 668
 669                if Project = Main_Project
 670                  or else Data.Other_Sources_Present
 671                then
 672                   Add_Archive_Path;
 673                end if;
 674             end if;
 675          end if;
 676       end Recursive_Add_Archives;
 677
 678    --  Start of processing for Add_Archives
 679
 680    begin
 681       --  First, mark all projects as not processed
 682
 683       for Project in Project_Table.First ..
 684                      Project_Table.Last (Project_Tree.Projects)
 685       loop
 686          Project_Tree.Projects.Table (Project).Seen := False;
 687       end loop;
 688
 689       --  Take care of the run path option
 690
 691       if Path_Option = null then
 692          Path_Option := MLib.Linker_Library_Path_Option;
 693       end if;
 694
 695       Lib_Path.Set_Last (0);
 696
 697       --  Add archives in the reverse order
 698
 699       Recursive_Add_Archives (Main_Project);
 700
 701       --  And reverse the order
 702
 703       declare
 704          First : Positive;
 705          Last  : Natural;
 706          Temp  : String_Access;
 707
 708       begin
 709          First := Last_Arg + 1;
 710          Last  := Last_Argument;
 711          while First < Last loop
 712             Temp := Arguments (First);
 713             Arguments (First) := Arguments (Last);
 714             Arguments (Last)  := Temp;
 715             First := First + 1;
 716             Last := Last - 1;
 717          end loop;
 718       end;
 719    end Add_Archives;
 720
 721    ------------------
 722    -- Add_Argument --
 723    ------------------
 724
 725    procedure Add_Argument (Arg : String_Access; Display : Boolean) is
 726    begin
 727       --  Nothing to do if no argument is specified or if argument is empty
 728
 729       if Arg /= null or else Arg'Length = 0 then
 730
 731          --  Reallocate arrays if necessary
 732
 733          if Last_Argument = Arguments'Last then
 734             declare
 735                New_Arguments : constant Argument_List_Access :=
 736                                  new Argument_List
 737                                    (1 .. Last_Argument +
 738                                            Initial_Argument_Count);
 739
 740                New_Arguments_Displayed : constant Booleans :=
 741                                            new Boolean_Array
 742                                              (1 .. Last_Argument +
 743                                                      Initial_Argument_Count);
 744
 745             begin
 746                New_Arguments (Arguments'Range) := Arguments.all;
 747
 748                --  To avoid deallocating the strings, nullify all components
 749                --  of Arguments before calling Free.
 750
 751                Arguments.all := (others => null);
 752
 753                Free (Arguments);
 754                Arguments := New_Arguments;
 755
 756                New_Arguments_Displayed (Arguments_Displayed'Range) :=
 757                  Arguments_Displayed.all;
 758                Free (Arguments_Displayed);
 759                Arguments_Displayed := New_Arguments_Displayed;
 760             end;
 761          end if;
 762
 763          --  Add the argument and its display indication
 764
 765          Last_Argument := Last_Argument + 1;
 766          Arguments (Last_Argument) := Arg;
 767          Arguments_Displayed (Last_Argument) := Display;
 768       end if;
 769    end Add_Argument;
 770
 771    procedure Add_Argument (Arg : String; Display : Boolean) is
 772       Argument : String_Access := null;
 773
 774    begin
 775       --  Nothing to do if argument is empty
 776
 777       if Arg'Length > 0 then
 778
 779          --  Check if the argument is already in the Cache_Args table.
 780          --  If it is already there, reuse the allocated value.
 781
 782          for Index in 1 .. Cache_Args.Last loop
 783             if Cache_Args.Table (Index).all = Arg then
 784                Argument := Cache_Args.Table (Index);
 785                exit;
 786             end if;
 787          end loop;
 788
 789          --  If the argument is not in the cache, create a new entry in the
 790          --  cache.
 791
 792          if Argument = null then
 793             Argument := new String'(Arg);
 794             Cache_Args.Increment_Last;
 795             Cache_Args.Table (Cache_Args.Last) := Argument;
 796          end if;
 797
 798          --  And add the argument
 799
 800          Add_Argument (Argument, Display);
 801       end if;
 802    end Add_Argument;
 803
 804    -------------------
 805    -- Add_Arguments --
 806    -------------------
 807
 808    procedure Add_Arguments (Args : Argument_List; Display : Boolean) is
 809    begin
 810       --  Reallocate the arrays, if necessary
 811
 812       if Last_Argument + Args'Length > Arguments'Last then
 813          declare
 814             New_Arguments : constant Argument_List_Access :=
 815                               new Argument_List
 816                                     (1 .. Last_Argument + Args'Length +
 817                                           Initial_Argument_Count);
 818
 819             New_Arguments_Displayed : constant Booleans :=
 820                                         new Boolean_Array
 821                                               (1 .. Last_Argument +
 822                                                     Args'Length +
 823                                                     Initial_Argument_Count);
 824
 825          begin
 826             New_Arguments (1 .. Last_Argument) :=
 827               Arguments (1 .. Last_Argument);
 828
 829             --  To avoid deallocating the strings, nullify all components
 830             --  of Arguments before calling Free.
 831
 832             Arguments.all := (others => null);
 833             Free (Arguments);
 834
 835             Arguments := New_Arguments;
 836             New_Arguments_Displayed (1 .. Last_Argument) :=
 837               Arguments_Displayed (1 .. Last_Argument);
 838             Free (Arguments_Displayed);
 839             Arguments_Displayed := New_Arguments_Displayed;
 840          end;
 841       end if;
 842
 843       --  Add the new arguments and the display indications
 844
 845       Arguments (Last_Argument + 1 .. Last_Argument + Args'Length) := Args;
 846       Arguments_Displayed (Last_Argument + 1 .. Last_Argument + Args'Length) :=
 847         (others => Display);
 848       Last_Argument := Last_Argument + Args'Length;
 849    end Add_Arguments;
 850
 851    ----------------
 852    -- Add_Option --
 853    ----------------
 854
 855    procedure Add_Option (Arg : String) is
 856       Option : constant String_Access := new String'(Arg);
 857
 858    begin
 859       case Current_Processor is
 860          when None =>
 861             null;
 862
 863          when Linker =>
 864
 865             --  Add option to the linker table
 866
 867             Linker_Options.Increment_Last;
 868             Linker_Options.Table (Linker_Options.Last) := Option;
 869
 870          when Compiler =>
 871
 872             --  Add option to the compiler option table, depending on the
 873             --  value of Current_Language.
 874
 875             Comp_Opts.Increment_Last (Options (Current_Language));
 876             Options (Current_Language).Table
 877               (Comp_Opts.Last (Options (Current_Language))) := Option;
 878
 879       end case;
 880    end Add_Option;
 881
 882    -------------------
 883    -- Add_Source_Id --
 884    -------------------
 885
 886    procedure Add_Source_Id (Project : Project_Id; Id : Other_Source_Id) is
 887    begin
 888       --  Reallocate the array, if necessary
 889
 890       if Last_Source = Source_Indexes'Last then
 891          declare
 892             New_Indexes : constant Source_Indexes_Ref :=
 893                             new Source_Index_Array
 894                               (1 .. Source_Indexes'Last +
 895                                       Initial_Source_Index_Count);
 896          begin
 897             New_Indexes (Source_Indexes'Range) := Source_Indexes.all;
 898             Free (Source_Indexes);
 899             Source_Indexes := New_Indexes;
 900          end;
 901       end if;
 902
 903       Last_Source := Last_Source + 1;
 904       Source_Indexes (Last_Source) := (Project, Id, False);
 905    end Add_Source_Id;
 906
 907    ----------------------------
 908    -- Add_Search_Directories --
 909    ----------------------------
 910
 911    procedure Add_Search_Directories
 912      (Data     : Project_Data;
 913       Language : First_Language_Indexes)
 914    is
 915    begin
 916       --  If a GNU compiler is used, set the CPATH environment variable,
 917       --  if it does not already has the correct value.
 918
 919       if Compiler_Is_Gcc (Language) then
 920          if Current_Include_Paths (Language) /= Data.Include_Path then
 921             Current_Include_Paths (Language) := Data.Include_Path;
 922             Setenv (CPATH, Data.Include_Path.all);
 923          end if;
 924
 925       else
 926          Add_Arguments (Data.Imported_Directories_Switches.all, Verbose_Mode);
 927       end if;
 928    end Add_Search_Directories;
 929
 930    ------------------
 931    -- Add_Switches --
 932    ------------------
 933
 934    procedure Add_Switches
 935      (Data      : Project_Data;
 936       Proc      : Processor;
 937       Language  : Language_Index;
 938       File_Name : File_Name_Type)
 939    is
 940       Switches       : Variable_Value;
 941       --  The switches, if any, for the file/language
 942
 943       Pkg            : Package_Id;
 944       --  The id of the package where to look for the switches
 945
 946       Defaults       : Array_Element_Id;
 947       --  The Default_Switches associative array
 948
 949       Switches_Array : Array_Element_Id;
 950       --  The Switches associative array
 951
 952       Element_Id     : String_List_Id;
 953       Element        : String_Element;
 954
 955    begin
 956       --  First, choose the proper package
 957
 958       case Proc is
 959          when None =>
 960             raise Program_Error;
 961
 962          when Linker =>
 963             Pkg := Value_Of (Name_Linker, Data.Decl.Packages, Project_Tree);
 964
 965          when Compiler =>
 966             Pkg := Value_Of (Name_Compiler, Data.Decl.Packages, Project_Tree);
 967       end case;
 968
 969       if Pkg /= No_Package then
 970
 971          --  Get the Switches ("file name"), if they exist
 972
 973          Switches_Array := Prj.Util.Value_Of
 974            (Name      => Name_Switches,
 975             In_Arrays => Project_Tree.Packages.Table
 976                           (Pkg).Decl.Arrays,
 977             In_Tree   => Project_Tree);
 978
 979          Switches :=
 980            Prj.Util.Value_Of
 981              (Index     => Name_Id (File_Name),
 982               Src_Index => 0,
 983               In_Array  => Switches_Array,
 984               In_Tree   => Project_Tree);
 985
 986          --  Otherwise, get the Default_Switches ("language"), if they exist
 987
 988          if Switches = Nil_Variable_Value then
 989             Defaults := Prj.Util.Value_Of
 990               (Name      => Name_Default_Switches,
 991                In_Arrays => Project_Tree.Packages.Table
 992                               (Pkg).Decl.Arrays,
 993                In_Tree   => Project_Tree);
 994             Switches := Prj.Util.Value_Of
 995               (Index     => Language_Names.Table (Language),
 996                Src_Index => 0,
 997                In_Array  => Defaults,
 998                In_Tree   => Project_Tree);
 999          end if;
1000
1001          --  If there are switches, add them to Arguments
1002
1003          if Switches /= Nil_Variable_Value then
1004             Element_Id := Switches.Values;
1005             while Element_Id /= Nil_String loop
1006                Element := Project_Tree.String_Elements.Table
1007                             (Element_Id);
1008
1009                if Element.Value /= No_Name then
1010                   Get_Name_String (Element.Value);
1011
1012                   if not Quiet_Output then
1013
1014                      --  When not in quiet output (no -q), check that the
1015                      --  switch is not the concatenation of several valid
1016                      --  switches, such as "-g -v". If it is, issue a warning.
1017
1018                      Check (Option => Name_Buffer (1 .. Name_Len));
1019                   end if;
1020
1021                   Add_Argument (Name_Buffer (1 .. Name_Len), True);
1022                end if;
1023
1024                Element_Id := Element.Next;
1025             end loop;
1026          end if;
1027       end if;
1028    end Add_Switches;
1029
1030    --------------------------
1031    -- Build_Global_Archive --
1032    --------------------------
1033
1034    procedure Build_Global_Archive is
1035       Data      : Project_Data := Project_Tree.Projects.Table (Main_Project);
1036       Source_Id : Other_Source_Id;
1037       S_Id      : Other_Source_Id;
1038       Source    : Other_Source;
1039       Success   : Boolean;
1040
1041       Archive_Name : constant String :=
1042                        "lib"
1043                          & Get_Name_String (Data.Display_Name)
1044                          & '.'
1045                          & Archive_Ext;
1046       --  The name of the archive file for this project
1047
1048       Archive_Dep_Name : constant String :=
1049                            "lib"
1050                              & Get_Name_String (Data.Display_Name)
1051                              & ".deps";
1052       --  The name of the archive dependency file for this project
1053
1054       Need_To_Rebuild : Boolean := Need_To_Rebuild_Global_Archive;
1055       --  When True, archive will be rebuilt
1056
1057       File                : Prj.Util.Text_File;
1058       Object_Path         : Path_Name_Type;
1059       Time_Stamp          : Time_Stamp_Type;
1060       Saved_Last_Argument : Natural;
1061       First_Object        : Natural;
1062       Discard             : Boolean;
1063
1064    begin
1065       Check_Archive_Builder;
1066
1067       if Project_Of_Current_Object_Directory /= Main_Project then
1068          Project_Of_Current_Object_Directory := Main_Project;
1069          Change_Dir (Get_Name_String (Data.Object_Directory));
1070
1071          if Verbose_Mode then
1072             Write_Str  ("Changing to object directory of """);
1073             Write_Name (Data.Display_Name);
1074             Write_Str  (""": """);
1075             Write_Name (Data.Display_Object_Dir);
1076             Write_Line ("""");
1077          end if;
1078       end if;
1079
1080       if not Need_To_Rebuild then
1081          if Verbose_Mode then
1082             Write_Str  ("   Checking ");
1083             Write_Line (Archive_Name);
1084          end if;
1085
1086          --  If the archive does not exist, of course it needs to be built
1087
1088          if not Is_Regular_File (Archive_Name) then
1089             Need_To_Rebuild := True;
1090
1091             if Verbose_Mode then
1092                Write_Line ("      -> archive does not exist");
1093             end if;
1094
1095          --  Archive does exist
1096
1097          else
1098             --  Check the archive dependency file
1099
1100             Open (File, Archive_Dep_Name);
1101
1102             --  If the archive dependency file does not exist, we need to
1103             --  rebuild the archive and to create its dependency file.
1104
1105             if not Is_Valid (File) then
1106                Need_To_Rebuild := True;
1107
1108                if Verbose_Mode then
1109                   Write_Str  ("      -> archive dependency file ");
1110                   Write_Str  (Archive_Dep_Name);
1111                   Write_Line (" does not exist");
1112                end if;
1113
1114             else
1115                --  Put all sources of language other than Ada in Source_Indexes
1116
1117                declare
1118                   Local_Data : Project_Data;
1119
1120                begin
1121                   Last_Source := 0;
1122
1123                   for Proj in Project_Table.First ..
1124                     Project_Table.Last (Project_Tree.Projects)
1125                   loop
1126                      Local_Data := Project_Tree.Projects.Table (Proj);
1127
1128                      if not Local_Data.Library then
1129                         Source_Id := Local_Data.First_Other_Source;
1130                         while Source_Id /= No_Other_Source loop
1131                            Add_Source_Id (Proj, Source_Id);
1132                            Source_Id := Project_Tree.Other_Sources.Table
1133                              (Source_Id).Next;
1134                         end loop;
1135                      end if;
1136                   end loop;
1137                end;
1138
1139                --  Read the dependency file, line by line
1140
1141                while not End_Of_File (File) loop
1142                   Get_Line (File, Name_Buffer, Name_Len);
1143
1144                   --  First line is the path of the object file
1145
1146                   Object_Path := Name_Find;
1147                   Source_Id := No_Other_Source;
1148
1149                   --  Check if this object file is for a source of this project
1150
1151                   for S in 1 .. Last_Source loop
1152                      S_Id := Source_Indexes (S).Id;
1153                      Source := Project_Tree.Other_Sources.Table (S_Id);
1154
1155                      if (not Source_Indexes (S).Found)
1156                        and then Source.Object_Path = Object_Path
1157                      then
1158                         --  We have found the object file: get the source data,
1159                         --  and mark it as found.
1160
1161                         Source_Id := S_Id;
1162                         Source_Indexes (S).Found := True;
1163                         exit;
1164                      end if;
1165                   end loop;
1166
1167                   --  If it is not for a source of this project, then the
1168                   --  archive needs to be rebuilt.
1169
1170                   if Source_Id = No_Other_Source then
1171                      Need_To_Rebuild := True;
1172                      if Verbose_Mode then
1173                         Write_Str  ("      -> ");
1174                         Write_Str  (Get_Name_String (Object_Path));
1175                         Write_Line (" is not an object of any project");
1176                      end if;
1177
1178                      exit;
1179                   end if;
1180
1181                   --  The second line is the time stamp of the object file. If
1182                   --  there is no next line, then the dependency file is
1183                   --  truncated, and the archive need to be rebuilt.
1184
1185                   if End_Of_File (File) then
1186                      Need_To_Rebuild := True;
1187
1188                      if Verbose_Mode then
1189                         Write_Str  ("      -> archive dependency file ");
1190                         Write_Line (" is truncated");
1191                      end if;
1192
1193                      exit;
1194                   end if;
1195
1196                   Get_Line (File, Name_Buffer, Name_Len);
1197
1198                   --  If the line has the wrong number of characters, then
1199                   --  the dependency file is incorrectly formatted, and the
1200                   --  archive needs to be rebuilt.
1201
1202                   if Name_Len /= Time_Stamp_Length then
1203                      Need_To_Rebuild := True;
1204
1205                      if Verbose_Mode then
1206                         Write_Str  ("      -> archive dependency file ");
1207                         Write_Line (" is incorrectly formatted (time stamp)");
1208                      end if;
1209
1210                      exit;
1211                   end if;
1212
1213                   Time_Stamp := Time_Stamp_Type (Name_Buffer (1 .. Name_Len));
1214
1215                   --  If the time stamp in the dependency file is different
1216                   --  from the time stamp of the object file, then the archive
1217                   --  needs to be rebuilt.
1218
1219                   if Time_Stamp /= Source.Object_TS then
1220                      Need_To_Rebuild := True;
1221
1222                      if Verbose_Mode then
1223                         Write_Str  ("      -> time stamp of ");
1224                         Write_Str  (Get_Name_String (Object_Path));
1225                         Write_Str  (" is incorrect in the archive");
1226                         Write_Line (" dependency file");
1227                      end if;
1228
1229                      exit;
1230                   end if;
1231                end loop;
1232
1233                Close (File);
1234             end if;
1235          end if;
1236       end if;
1237
1238       if not Need_To_Rebuild then
1239          if Verbose_Mode then
1240             Write_Line  ("      -> up to date");
1241          end if;
1242
1243          --  No need to create a global archive, if there is no object
1244          --  file to put into.
1245
1246          Global_Archive_Exists := Last_Source /= 0;
1247
1248       --  Archive needs to be rebuilt
1249
1250       else
1251          --  If archive already exists, first delete it
1252
1253          --  Comment needed on why we discard result???
1254
1255          if Is_Regular_File (Archive_Name) then
1256             Delete_File (Archive_Name, Discard);
1257          end if;
1258
1259          Last_Argument := 0;
1260
1261          --  Start with the options found in MLib.Tgt (usually just "rc")
1262
1263          Add_Arguments (Archive_Builder_Options.all, True);
1264
1265          --  Followed by the archive name
1266
1267          Add_Argument (Archive_Name, True);
1268
1269          First_Object := Last_Argument;
1270
1271          --  Followed by all the object files of the non library projects
1272
1273          for Proj in Project_Table.First ..
1274                      Project_Table.Last (Project_Tree.Projects)
1275          loop
1276             Data := Project_Tree.Projects.Table (Proj);
1277
1278             if not Data.Library then
1279                Source_Id := Data.First_Other_Source;
1280                while Source_Id /= No_Other_Source loop
1281                   Source :=
1282                     Project_Tree.Other_Sources.Table (Source_Id);
1283
1284                   --  Only include object file name that have not been
1285                   --  overriden in extending projects.
1286
1287                   if Is_Included_In_Global_Archive
1288                        (Source.Object_Name, Proj)
1289                   then
1290                      Add_Argument
1291                        (Get_Name_String (Source.Object_Path),
1292                         Verbose_Mode or (First_Object = Last_Argument));
1293                   end if;
1294
1295                   Source_Id := Source.Next;
1296                end loop;
1297             end if;
1298          end loop;
1299
1300          --  No need to create a global archive, if there is no object
1301          --  file to put into.
1302
1303          Global_Archive_Exists := Last_Argument > First_Object;
1304
1305          if Global_Archive_Exists then
1306
1307             --  If the archive is built, then linking will need to occur
1308             --  unconditionally.
1309
1310             Need_To_Relink := True;
1311
1312             --  Spawn the archive builder (ar)
1313
1314             Saved_Last_Argument := Last_Argument;
1315             Last_Argument := First_Object + Max_In_Archives;
1316             loop
1317                if Last_Argument > Saved_Last_Argument then
1318                   Last_Argument := Saved_Last_Argument;
1319                end if;
1320
1321                Display_Command
1322                  (Archive_Builder,
1323                   Archive_Builder_Path,
1324                   Ellipse => True);
1325
1326                Spawn
1327                  (Archive_Builder_Path.all,
1328                   Arguments (1 .. Last_Argument),
1329                   Success);
1330
1331                exit when not Success
1332                  or else Last_Argument = Saved_Last_Argument;
1333
1334                Arguments (1) := r;
1335                Arguments (3 .. Saved_Last_Argument - Last_Argument + 2) :=
1336                  Arguments (Last_Argument + 1 .. Saved_Last_Argument);
1337                Saved_Last_Argument := Saved_Last_Argument - Last_Argument + 2;
1338             end loop;
1339
1340             --  If the archive was built, run the archive indexer (ranlib)
1341             --  if there is one.
1342
1343             if Success then
1344
1345                if Archive_Indexer_Path /= null then
1346                   Last_Argument := 0;
1347                   Add_Argument (Archive_Name, True);
1348
1349                   Display_Command (Archive_Indexer, Archive_Indexer_Path);
1350
1351                   Spawn
1352                     (Archive_Indexer_Path.all, Arguments (1 .. 1), Success);
1353
1354                   if not Success then
1355
1356                      --  Running ranlib failed, delete the dependency file,
1357                      --  if it exists.
1358
1359                      if Is_Regular_File (Archive_Dep_Name) then
1360                         Delete_File (Archive_Dep_Name, Success);
1361                      end if;
1362
1363                      --  And report the error
1364
1365                      Report_Error
1366                        ("running" & Archive_Indexer & " for project """,
1367                         Get_Name_String (Data.Display_Name),
1368                         """ failed");
1369                      return;
1370                   end if;
1371                end if;
1372
1373                --  The archive was correctly built, create its dependency file
1374
1375                Create_Global_Archive_Dependency_File (Archive_Dep_Name);
1376
1377             --  Building the archive failed, delete dependency file if one
1378             --  exists.
1379
1380             else
1381                if Is_Regular_File (Archive_Dep_Name) then
1382                   Delete_File (Archive_Dep_Name, Success);
1383                end if;
1384
1385                --  And report the error
1386
1387                Report_Error
1388                  ("building archive for project """,
1389                   Get_Name_String (Data.Display_Name),
1390                   """ failed");
1391             end if;
1392          end if;
1393       end if;
1394    end Build_Global_Archive;
1395
1396    -------------------
1397    -- Build_Library --
1398    -------------------
1399
1400    procedure Build_Library (Project : Project_Id; Unconditionally : Boolean) is
1401       Data      : constant Project_Data :=
1402                     Project_Tree.Projects.Table (Project);
1403       Source_Id : Other_Source_Id;
1404       Source    : Other_Source;
1405
1406       Archive_Name : constant String :=
1407                        "lib" & Get_Name_String (Data.Display_Name)
1408                        & '.' & Archive_Ext;
1409       --  The name of the archive file for this project
1410
1411       Archive_Dep_Name : constant String :=
1412                            "lib" & Get_Name_String (Data.Display_Name)
1413                            & ".deps";
1414       --  The name of the archive dependency file for this project
1415
1416       Need_To_Rebuild : Boolean := Unconditionally;
1417       --  When True, archive will be rebuilt
1418
1419       File : Prj.Util.Text_File;
1420
1421       Object_Name : File_Name_Type;
1422       Time_Stamp  : Time_Stamp_Type;
1423       Driver_Name : Name_Id := No_Name;
1424
1425       Lib_Opts    : Argument_List_Access := No_Argument'Access;
1426
1427    begin
1428       Check_Archive_Builder;
1429
1430       --  If Unconditionally is False, check if the archive need to be built
1431
1432       if not Need_To_Rebuild then
1433          if Verbose_Mode then
1434             Write_Str  ("   Checking ");
1435             Write_Line (Archive_Name);
1436          end if;
1437
1438          --  If the archive does not exist, of course it needs to be built
1439
1440          if not Is_Regular_File (Archive_Name) then
1441             Need_To_Rebuild := True;
1442
1443             if Verbose_Mode then
1444                Write_Line ("      -> archive does not exist");
1445             end if;
1446
1447          --  Archive does exist
1448
1449          else
1450             --  Check the archive dependency file
1451
1452             Open (File, Archive_Dep_Name);
1453
1454             --  If the archive dependency file does not exist, we need to
1455             --  rebuild the archive and to create its dependency file.
1456
1457             if not Is_Valid (File) then
1458                Need_To_Rebuild := True;
1459
1460                if Verbose_Mode then
1461                   Write_Str  ("      -> archive dependency file ");
1462                   Write_Str  (Archive_Dep_Name);
1463                   Write_Line (" does not exist");
1464                end if;
1465
1466             else
1467                --  Put all sources of language other than Ada in Source_Indexes
1468
1469                Last_Source := 0;
1470
1471                Source_Id := Data.First_Other_Source;
1472                while Source_Id /= No_Other_Source loop
1473                   Add_Source_Id (Project, Source_Id);
1474                   Source_Id :=
1475                     Project_Tree.Other_Sources.Table (Source_Id).Next;
1476                end loop;
1477
1478                --  Read the dependency file, line by line
1479
1480                while not End_Of_File (File) loop
1481                   Get_Line (File, Name_Buffer, Name_Len);
1482
1483                   --  First line is the name of an object file
1484
1485                   Object_Name := Name_Find;
1486                   Source_Id := No_Other_Source;
1487
1488                   --  Check if this object file is for a source of this project
1489
1490                   for S in 1 .. Last_Source loop
1491                      if (not Source_Indexes (S).Found)
1492                        and then
1493                          Project_Tree.Other_Sources.Table
1494                            (Source_Indexes (S).Id).Object_Name = Object_Name
1495                      then
1496                         --  We have found the object file: get the source
1497                         --  data, and mark it as found.
1498
1499                         Source_Id := Source_Indexes (S).Id;
1500                         Source := Project_Tree.Other_Sources.Table
1501                                     (Source_Id);
1502                         Source_Indexes (S).Found := True;
1503                         exit;
1504                      end if;
1505                   end loop;
1506
1507                   --  If it is not for a source of this project, then the
1508                   --  archive needs to be rebuilt.
1509
1510                   if Source_Id = No_Other_Source then
1511                      Need_To_Rebuild := True;
1512
1513                      if Verbose_Mode then
1514                         Write_Str  ("      -> ");
1515                         Write_Str  (Get_Name_String (Object_Name));
1516                         Write_Line (" is not an object of the project");
1517                      end if;
1518
1519                      exit;
1520                   end if;
1521
1522                   --  The second line is the time stamp of the object file.
1523                   --  If there is no next line, then the dependency file is
1524                   --  truncated, and the archive need to be rebuilt.
1525
1526                   if End_Of_File (File) then
1527                      Need_To_Rebuild := True;
1528
1529                      if Verbose_Mode then
1530                         Write_Str  ("      -> archive dependency file ");
1531                         Write_Line (" is truncated");
1532                      end if;
1533
1534                      exit;
1535                   end if;
1536
1537                   Get_Line (File, Name_Buffer, Name_Len);
1538
1539                   --  If the line has the wrong number of character, then
1540                   --  the dependency file is incorrectly formatted, and the
1541                   --  archive needs to be rebuilt.
1542
1543                   if Name_Len /= Time_Stamp_Length then
1544                      Need_To_Rebuild := True;
1545
1546                      if Verbose_Mode then
1547                         Write_Str  ("      -> archive dependency file ");
1548                         Write_Line (" is incorrectly formatted (time stamp)");
1549                      end if;
1550
1551                      exit;
1552                   end if;
1553
1554                   Time_Stamp := Time_Stamp_Type (Name_Buffer (1 .. Name_Len));
1555
1556                   --  If the time stamp in the dependency file is different
1557                   --  from the time stamp of the object file, then the archive
1558                   --  needs to be rebuilt.
1559
1560                   if Time_Stamp /= Source.Object_TS then
1561                      Need_To_Rebuild := True;
1562
1563                      if Verbose_Mode then
1564                         Write_Str  ("      -> time stamp of ");
1565                         Write_Str  (Get_Name_String (Object_Name));
1566                         Write_Str  (" is incorrect in the archive");
1567                         Write_Line (" dependency file");
1568                      end if;
1569
1570                      exit;
1571                   end if;
1572                end loop;
1573
1574                Close (File);
1575
1576                if not Need_To_Rebuild then
1577
1578                   --  Now, check if all object files of the project have been
1579                   --  accounted for. If any of them is not in the dependency
1580                   --  file, the archive needs to be rebuilt.
1581
1582                   for Index in 1 .. Last_Source loop
1583                      if not Source_Indexes (Index).Found then
1584                         Need_To_Rebuild := True;
1585
1586                         if Verbose_Mode then
1587                            Source_Id := Source_Indexes (Index).Id;
1588                            Source := Project_Tree.Other_Sources.Table
1589                                        (Source_Id);
1590                            Write_Str  ("      -> ");
1591                            Write_Str  (Get_Name_String (Source.Object_Name));
1592                            Write_Str  (" is not in the archive ");
1593                            Write_Line ("dependency file");
1594                         end if;
1595
1596                         exit;
1597                      end if;
1598                   end loop;
1599                end if;
1600
1601                if (not Need_To_Rebuild) and Verbose_Mode then
1602                   Write_Line ("      -> up to date");
1603                end if;
1604             end if;
1605          end if;
1606       end if;
1607
1608       --  Build the library if necessary
1609
1610       if Need_To_Rebuild then
1611
1612          --  If a library is built, then linking will need to occur
1613          --  unconditionally.
1614
1615          Need_To_Relink := True;
1616
1617          Last_Argument := 0;
1618
1619          --  If there are sources in Ada, then gnatmake will build the library,
1620          --  so nothing to do.
1621
1622          if not Data.Languages (Ada_Language_Index) then
1623
1624             --  Get all the object files of the project
1625
1626             Source_Id := Data.First_Other_Source;
1627             while Source_Id /= No_Other_Source loop
1628                Source := Project_Tree.Other_Sources.Table (Source_Id);
1629                Add_Argument
1630                  (Get_Name_String (Source.Object_Name), Verbose_Mode);
1631                Source_Id := Source.Next;
1632             end loop;
1633
1634             --  If it is a library, it need to be built it the same way Ada
1635             --  libraries are built.
1636
1637             if Data.Library_Kind = Static then
1638                MLib.Build_Library
1639                  (Ofiles      => Arguments (1 .. Last_Argument),
1640                   Afiles      => No_Argument,
1641                   Output_File => Get_Name_String (Data.Library_Name),
1642                   Output_Dir  => Get_Name_String (Data.Display_Library_Dir));
1643
1644             else
1645                --  Link with g++ if C++ is one of the languages, otherwise
1646                --  building the library may fail with unresolved symbols.
1647
1648                if C_Plus_Plus_Is_Used then
1649                   if Compiler_Names (C_Plus_Plus_Language_Index) = null then
1650                      Get_Compiler (C_Plus_Plus_Language_Index);
1651                   end if;
1652
1653                   if Compiler_Is_Gcc (C_Plus_Plus_Language_Index) then
1654                      Name_Len := 0;
1655                      Add_Str_To_Name_Buffer
1656                        (Compiler_Names (C_Plus_Plus_Language_Index).all);
1657                      Driver_Name := Name_Find;
1658                   end if;
1659                end if;
1660
1661                --  If Library_Options is specified, add these options
1662
1663                declare
1664                   Library_Options : constant Variable_Value :=
1665                                       Value_Of
1666                                         (Name_Library_Options,
1667                                          Data.Decl.Attributes,
1668                                          Project_Tree);
1669
1670                begin
1671                   if not Library_Options.Default then
1672                      declare
1673                         Current : String_List_Id;
1674                         Element : String_Element;
1675
1676                      begin
1677                         Current := Library_Options.Values;
1678                         while Current /= Nil_String loop
1679                            Element :=
1680                              Project_Tree.String_Elements.Table (Current);
1681                            Get_Name_String (Element.Value);
1682
1683                            if Name_Len /= 0 then
1684                               Library_Opts.Increment_Last;
1685                               Library_Opts.Table (Library_Opts.Last) :=
1686                                 new String'(Name_Buffer (1 .. Name_Len));
1687                            end if;
1688
1689                            Current := Element.Next;
1690                         end loop;
1691                      end;
1692                   end if;
1693
1694                   Lib_Opts :=
1695                     new Argument_List'(Argument_List
1696                        (Library_Opts.Table (1 .. Library_Opts.Last)));
1697                end;
1698
1699                MLib.Tgt.Build_Dynamic_Library
1700                  (Ofiles       => Arguments (1 .. Last_Argument),
1701                   Foreign      => Arguments (1 .. Last_Argument),
1702                   Afiles       => No_Argument,
1703                   Options      => No_Argument,
1704                   Options_2    => Lib_Opts.all,
1705                   Interfaces   => No_Argument,
1706                   Lib_Filename => Get_Name_String (Data.Library_Name),
1707                   Lib_Dir      => Get_Name_String (Data.Library_Dir),
1708                   Symbol_Data  => No_Symbols,
1709                   Driver_Name  => Driver_Name,
1710                   Lib_Version  => "",
1711                   Auto_Init    => False);
1712             end if;
1713          end if;
1714
1715          --  Create fake empty archive, so we can check its time stamp later
1716
1717          declare
1718             Archive : Ada.Text_IO.File_Type;
1719          begin
1720             Create (Archive, Out_File, Archive_Name);
1721             Close (Archive);
1722          end;
1723
1724          Create_Archive_Dependency_File
1725            (Archive_Dep_Name, Data.First_Other_Source);
1726       end if;
1727    end Build_Library;
1728
1729    -----------
1730    -- Check --
1731    -----------
1732
1733    procedure Check (Option : String) is
1734       First : Positive := Option'First;
1735       Last  : Natural;
1736
1737    begin
1738       for Index in Option'First + 1 .. Option'Last - 1 loop
1739          if Option (Index) = ' ' and then Option (Index + 1) = '-' then
1740             Write_Str ("warning: switch """);
1741             Write_Str (Option);
1742             Write_Str (""" is suspicious; consider using ");
1743
1744             Last := First;
1745             while Last <= Option'Last loop
1746                if Option (Last) = ' ' then
1747                   if First /= Option'First then
1748                      Write_Str (", ");
1749                   end if;
1750
1751                   Write_Char ('"');
1752                   Write_Str (Option (First .. Last - 1));
1753                   Write_Char ('"');
1754
1755                   while Last <= Option'Last and then Option (Last) = ' ' loop
1756                      Last := Last + 1;
1757                   end loop;
1758
1759                   First := Last;
1760
1761                else
1762                   if Last = Option'Last then
1763                      if First /= Option'First then
1764                         Write_Str (", ");
1765                      end if;
1766
1767                      Write_Char ('"');
1768                      Write_Str (Option (First .. Last));
1769                      Write_Char ('"');
1770                   end if;
1771
1772                   Last := Last + 1;
1773                end if;
1774             end loop;
1775
1776             Write_Line (" instead");
1777             exit;
1778          end if;
1779       end loop;
1780    end Check;
1781
1782    ---------------------------
1783    -- Check_Archive_Builder --
1784    ---------------------------
1785
1786    procedure Check_Archive_Builder is
1787    begin
1788       --  First, make sure that the archive builder (ar) is on the path
1789
1790       if Archive_Builder_Path = null then
1791          Archive_Builder_Path := Locate_Exec_On_Path (Archive_Builder);
1792
1793          if Archive_Builder_Path = null then
1794             Osint.Fail
1795               ("unable to locate archive builder """,
1796                Archive_Builder,
1797                """");
1798          end if;
1799
1800          --  If there is an archive indexer (ranlib), try to locate it on the
1801          --  path. Don't fail if it is not found.
1802
1803          if Archive_Indexer /= "" then
1804             Archive_Indexer_Path := Locate_Exec_On_Path (Archive_Indexer);
1805          end if;
1806       end if;
1807    end Check_Archive_Builder;
1808
1809    ------------------------------
1810    -- Check_Compilation_Needed --
1811    ------------------------------
1812
1813    procedure Check_Compilation_Needed
1814      (Source          : Other_Source;
1815       Need_To_Compile : out Boolean)
1816    is
1817       Source_Name   : constant String := Get_Name_String (Source.File_Name);
1818       Source_Path   : constant String := Get_Name_String (Source.Path_Name);
1819       Object_Name   : constant String := Get_Name_String (Source.Object_Name);
1820       Dep_Name      : constant String := Get_Name_String (Source.Dep_Name);
1821       C_Source_Path : String := Source_Path;
1822
1823       Source_In_Dependencies : Boolean := False;
1824       --  Set True if source was found in dependency file of its object file
1825
1826       Dep_File : Prj.Util.Text_File;
1827       Start    : Natural;
1828       Finish   : Natural;
1829
1830       Looping : Boolean := False;
1831       --  Set to True at the end of the first Big_Loop
1832
1833    begin
1834       Canonical_Case_File_Name (C_Source_Path);
1835
1836       --  Assume the worst, so that statement "return;" may be used if there
1837       --  is any problem.
1838
1839       Need_To_Compile := True;
1840
1841       if Verbose_Mode then
1842          Write_Str  ("   Checking ");
1843          Write_Str  (Source_Name);
1844          Write_Line (" ... ");
1845       end if;
1846
1847       --  If object file does not exist, of course source need to be compiled
1848
1849       if Source.Object_TS = Empty_Time_Stamp then
1850          if Verbose_Mode then
1851             Write_Str  ("      -> object file ");
1852             Write_Str  (Object_Name);
1853             Write_Line (" does not exist");
1854          end if;
1855
1856          return;
1857       end if;
1858
1859       --  If the object file has been created before the last modification
1860       --  of the source, the source need to be recompiled.
1861
1862       if Source.Object_TS < Source.Source_TS then
1863          if Verbose_Mode then
1864             Write_Str  ("      -> object file ");
1865             Write_Str  (Object_Name);
1866             Write_Line (" has time stamp earlier than source");
1867          end if;
1868
1869          return;
1870       end if;
1871
1872       --  If there is no dependency file, then the source needs to be
1873       --  recompiled and the dependency file need to be created.
1874
1875       if Source.Dep_TS = Empty_Time_Stamp then
1876          if Verbose_Mode then
1877             Write_Str  ("      -> dependency file ");
1878             Write_Str  (Dep_Name);
1879             Write_Line (" does not exist");
1880          end if;
1881
1882          return;
1883       end if;
1884
1885       --  The source needs to be recompiled if the source has been modified
1886       --  after the dependency file has been created.
1887
1888       if Source.Dep_TS < Source.Source_TS then
1889          if Verbose_Mode then
1890             Write_Str  ("      -> dependency file ");
1891             Write_Str  (Dep_Name);
1892             Write_Line (" has time stamp earlier than source");
1893          end if;
1894
1895          return;
1896       end if;
1897
1898       --  Look for all dependencies
1899
1900       Open (Dep_File, Dep_Name);
1901
1902       --  If dependency file cannot be open, we need to recompile the source
1903
1904       if not Is_Valid (Dep_File) then
1905          if Verbose_Mode then
1906             Write_Str  ("      -> could not open dependency file ");
1907             Write_Line (Dep_Name);
1908          end if;
1909
1910          return;
1911       end if;
1912
1913       --  Loop Big_Loop is executed several times only when the dependency file
1914       --  contains several times
1915       --     <object file>: <source1> ...
1916       --  When there is only one of such occurence, Big_Loop is exited
1917       --  successfully at the beginning of the second loop.
1918
1919       Big_Loop :
1920       loop
1921          declare
1922             End_Of_File_Reached : Boolean := False;
1923
1924          begin
1925             loop
1926                if End_Of_File (Dep_File) then
1927                   End_Of_File_Reached := True;
1928                   exit;
1929                end if;
1930
1931                Get_Line (Dep_File, Name_Buffer, Name_Len);
1932
1933                exit when Name_Len > 0 and then Name_Buffer (1) /= '#';
1934             end loop;
1935
1936             --  If dependency file contains only empty lines or comments, then
1937             --  dependencies are unknown, and the source needs to be
1938             --  recompiled.
1939
1940             if End_Of_File_Reached then
1941                --  If we have reached the end of file after the first loop,
1942                --  there is nothing else to do.
1943
1944                exit Big_Loop when Looping;
1945
1946                if Verbose_Mode then
1947                   Write_Str  ("      -> dependency file ");
1948                   Write_Str  (Dep_Name);
1949                   Write_Line (" is empty");
1950                end if;
1951
1952                Close (Dep_File);
1953                return;
1954             end if;
1955          end;
1956
1957          Start  := 1;
1958          Finish := Index (Name_Buffer (1 .. Name_Len), ": ");
1959
1960          --  First line must start with name of object file, followed by colon
1961
1962          if Finish = 0 or else
1963             Name_Buffer (1 .. Finish - 1) /= Object_Name
1964          then
1965             if Verbose_Mode then
1966                Write_Str  ("      -> dependency file ");
1967                Write_Str  (Dep_Name);
1968                Write_Line (" has wrong format");
1969             end if;
1970
1971             Close (Dep_File);
1972             return;
1973
1974          else
1975             Start := Finish + 2;
1976
1977             --  Process each line
1978
1979             Line_Loop : loop
1980                declare
1981                   Line : String  := Name_Buffer (1 .. Name_Len);
1982                   Last : Natural := Name_Len;
1983
1984                begin
1985                   Name_Loop : loop
1986
1987                      --  Find the beginning of the next source path name
1988
1989                      while Start < Last and then Line (Start) = ' ' loop
1990                         Start := Start + 1;
1991                      end loop;
1992
1993                      --  Go to next line when there is a continuation character
1994                      --  \ at the end of the line.
1995
1996                      exit Name_Loop when Start = Last
1997                        and then Line (Start) = '\';
1998
1999                      --  We should not be at the end of the line, without
2000                      --  a continuation character \.
2001
2002                      if Start = Last then
2003                         if Verbose_Mode then
2004                            Write_Str  ("      -> dependency file ");
2005                            Write_Str  (Dep_Name);
2006                            Write_Line (" has wrong format");
2007                         end if;
2008
2009                         Close (Dep_File);
2010                         return;
2011                      end if;
2012
2013                      --  Look for the end of the source path name
2014
2015                      Finish := Start;
2016                      while Finish < Last loop
2017                         if Line (Finish) = '\' then
2018
2019                            --  On Windows, a '\' is part of the path name,
2020                            --  except when it is followed by another '\' or by
2021                            --  a space. On other platforms, when we are getting
2022                            --  a '\' that is not the last character of the
2023                            --  line, the next character is part of the path
2024                            --  name, even if it is a space.
2025
2026                            if On_Windows
2027                              and then Line (Finish + 1) /= '\'
2028                              and then Line (Finish + 1) /= ' '
2029                            then
2030                               Finish := Finish + 1;
2031
2032                            else
2033                               Line (Finish .. Last - 1) :=
2034                                 Line (Finish + 1 .. Last);
2035                               Last := Last - 1;
2036                            end if;
2037
2038                         else
2039                            --  A space that is not preceded by '\' indicates
2040                            --  the end of the path name.
2041
2042                            exit when Line (Finish + 1) = ' ';
2043
2044                            Finish := Finish + 1;
2045                         end if;
2046                      end loop;
2047
2048                      --  Check this source
2049
2050                      declare
2051                         Src_Name : constant String :=
2052                                      Normalize_Pathname
2053                                        (Name           =>
2054                                                        Line (Start .. Finish),
2055                                         Resolve_Links  => False,
2056                                         Case_Sensitive => False);
2057                         Src_TS   : Time_Stamp_Type;
2058
2059                      begin
2060                         --  If it is original source, set
2061                         --  Source_In_Dependencies.
2062
2063                         if Src_Name = C_Source_Path then
2064                            Source_In_Dependencies := True;
2065                         end if;
2066
2067                         Name_Len := 0;
2068                         Add_Str_To_Name_Buffer (Src_Name);
2069                         Src_TS := File_Stamp (File_Name_Type'(Name_Find));
2070
2071                         --  If the source does not exist, we need to recompile
2072
2073                         if Src_TS = Empty_Time_Stamp then
2074                            if Verbose_Mode then
2075                               Write_Str  ("      -> source ");
2076                               Write_Str  (Src_Name);
2077                               Write_Line (" does not exist");
2078                            end if;
2079
2080                            Close (Dep_File);
2081                            return;
2082
2083                            --  If the source has been modified after the object
2084                            --  file, we need to recompile.
2085
2086                         elsif Src_TS > Source.Object_TS then
2087                            if Verbose_Mode then
2088                               Write_Str  ("      -> source ");
2089                               Write_Str  (Src_Name);
2090                               Write_Line
2091                                 (" has time stamp later than object file");
2092                            end if;
2093
2094                            Close (Dep_File);
2095                            return;
2096                         end if;
2097                      end;
2098
2099                      --  If the source path name ends the line, we are done
2100
2101                      exit Line_Loop when Finish = Last;
2102
2103                      --  Go get the next source on the line
2104
2105                      Start := Finish + 1;
2106                   end loop Name_Loop;
2107                end;
2108
2109                --  If we are here, we had a continuation character \ at the end
2110                --  of the line, so we continue with the next line.
2111
2112                Get_Line (Dep_File, Name_Buffer, Name_Len);
2113                Start := 1;
2114             end loop Line_Loop;
2115          end if;
2116
2117          --  Set Looping at the end of the first loop
2118          Looping := True;
2119       end loop Big_Loop;
2120
2121       Close (Dep_File);
2122
2123       --  If the original sources were not in the dependency file, then we
2124       --  need to recompile. It may mean that we are using a different source
2125       --  (different variant) for this object file.
2126
2127       if not Source_In_Dependencies then
2128          if Verbose_Mode then
2129             Write_Str  ("      -> source ");
2130             Write_Str  (Source_Path);
2131             Write_Line (" is not in the dependencies");
2132          end if;
2133
2134          return;
2135       end if;
2136
2137       --  If we are here, then everything is OK, no need to recompile
2138
2139       if Verbose_Mode then
2140          Write_Line ("      -> up to date");
2141       end if;
2142
2143       Need_To_Compile := False;
2144    end Check_Compilation_Needed;
2145
2146    ---------------------------
2147    -- Check_For_C_Plus_Plus --
2148    ---------------------------
2149
2150    procedure Check_For_C_Plus_Plus is
2151    begin
2152       C_Plus_Plus_Is_Used := False;
2153
2154       for Project in Project_Table.First ..
2155                      Project_Table.Last (Project_Tree.Projects)
2156       loop
2157          if
2158            Project_Tree.Projects.Table (Project).Languages
2159                                            (C_Plus_Plus_Language_Index)
2160          then
2161             C_Plus_Plus_Is_Used := True;
2162             exit;
2163          end if;
2164       end loop;
2165    end Check_For_C_Plus_Plus;
2166
2167    -------------
2168    -- Compile --
2169    -------------
2170
2171    procedure Compile
2172      (Source_Id    : Other_Source_Id;
2173       Data         : Project_Data;
2174       Local_Errors : in out Boolean)
2175    is
2176       Source  : Other_Source :=
2177                   Project_Tree.Other_Sources.Table (Source_Id);
2178       Success : Boolean;
2179       CPATH   : String_Access := null;
2180
2181    begin
2182       --  If the compiler is not known yet, get its path name
2183
2184       if Compiler_Names (Source.Language) = null then
2185          Get_Compiler (Source.Language);
2186       end if;
2187
2188       --  For non GCC compilers, get the dependency file, first calling the
2189       --  compiler with the switch -M.
2190
2191       if not Compiler_Is_Gcc (Source.Language) then
2192          Last_Argument := 0;
2193
2194          --  Add the source name, preceded by -M
2195
2196          Add_Argument (Dash_M, True);
2197          Add_Argument (Get_Name_String (Source.Path_Name), True);
2198
2199          --  Add the compiling switches for this source found in
2200          --  package Compiler of the project file, if they exist.
2201
2202          Add_Switches
2203            (Data, Compiler, Source.Language, Source.File_Name);
2204
2205          --  Add the compiling switches for the language specified
2206          --  on the command line, if any.
2207
2208          for
2209            J in 1 .. Comp_Opts.Last (Options (Source.Language))
2210          loop
2211             Add_Argument (Options (Source.Language).Table (J), True);
2212          end loop;
2213
2214          --  Finally, add imported directory switches for this project file
2215
2216          Add_Search_Directories (Data, Source.Language);
2217
2218          --  And invoke the compiler using GNAT.Expect
2219
2220          Display_Command
2221            (Compiler_Names (Source.Language).all,
2222             Compiler_Paths (Source.Language));
2223
2224          begin
2225             Non_Blocking_Spawn
2226               (FD,
2227                Compiler_Paths (Source.Language).all,
2228                Arguments (1 .. Last_Argument),
2229                Buffer_Size => 0,
2230                Err_To_Out => True);
2231
2232             declare
2233                Dep_File : Ada.Text_IO.File_Type;
2234                Result   : Expect_Match;
2235                Status   : Integer;
2236
2237             begin
2238                --  Create the dependency file
2239
2240                Create (Dep_File, Out_File, Get_Name_String (Source.Dep_Name));
2241
2242                loop
2243                   Expect (FD, Result, Line_Matcher);
2244
2245                   exit when Result = Expect_Timeout;
2246
2247                   declare
2248                      S : constant String := Strip_CR_LF (Expect_Out (FD));
2249
2250                   begin
2251                      --  Each line of the output is put in the dependency
2252                      --  file, including errors. If there are errors, the
2253                      --  syntax of the dependency file will be incorrect and
2254                      --  recompilation will occur automatically the next time
2255                      --  the dependencies are checked.
2256
2257                      Put_Line (Dep_File, S);
2258                   end;
2259                end loop;
2260
2261                --  If we are here, it means we had a timeout, so the
2262                --  dependency file may be incomplete. It is safer to
2263                --  delete it, otherwise the dependencies may be wrong.
2264
2265                Close (FD, Status);
2266                Close (Dep_File);
2267                Delete_File (Get_Name_String (Source.Dep_Name), Success);
2268
2269             exception
2270                when Process_Died =>
2271
2272                   --  This is the normal outcome. Just close the file
2273
2274                   Close (FD, Status);
2275                   Close (Dep_File);
2276
2277                when others =>
2278
2279                   --  Something wrong happened. It is safer to delete the
2280                   --  dependency file, otherwise the dependencies may be wrong.
2281
2282                   Close (FD, Status);
2283
2284                   if Is_Open (Dep_File) then
2285                      Close (Dep_File);
2286                   end if;
2287
2288                   Delete_File (Get_Name_String (Source.Dep_Name), Success);
2289             end;
2290
2291          exception
2292                --  If we cannot spawn the compiler, then the dependencies are
2293                --  not updated. It is safer then to delete the dependency file,
2294                --  otherwise the dependencies may be wrong.
2295
2296             when Invalid_Process =>
2297                Delete_File (Get_Name_String (Source.Dep_Name), Success);
2298          end;
2299       end if;
2300
2301       Last_Argument := 0;
2302
2303       --  For GCC compilers, make sure the language is always specified to
2304       --  to the GCC driver, in case the extension is not recognized by the
2305       --  GCC driver as a source of the language.
2306
2307       if Compiler_Is_Gcc (Source.Language) then
2308          Add_Argument (Dash_x, Verbose_Mode);
2309          Add_Argument
2310            (Get_Name_String (Language_Names.Table (Source.Language)),
2311             Verbose_Mode);
2312       end if;
2313
2314       Add_Argument (Dash_c, True);
2315
2316       --  Add the compiling switches for this source found in package Compiler
2317       --  of the project file, if they exist.
2318
2319       Add_Switches
2320         (Data, Compiler, Source.Language, Source.File_Name);
2321
2322       --  Specify the source to be compiled
2323
2324       Add_Argument (Get_Name_String (Source.Path_Name), True);
2325
2326       --  If non static library project, compile with the PIC option if there
2327       --  is one (when there is no PIC option, MLib.Tgt.PIC_Option returns an
2328       --  empty string, and Add_Argument with an empty string has no effect).
2329
2330       if Data.Library and then Data.Library_Kind /= Static then
2331          Add_Argument (PIC_Option, True);
2332       end if;
2333
2334       --  Indicate the name of the object
2335
2336       Add_Argument (Dash_o, True);
2337       Add_Argument (Get_Name_String (Source.Object_Name), True);
2338
2339       --  When compiler is GCC, use the magic switch that creates the
2340       --  dependency file in the correct format.
2341
2342       if Compiler_Is_Gcc (Source.Language) then
2343          Add_Argument
2344            ("-Wp,-MD," & Get_Name_String (Source.Dep_Name),
2345             Verbose_Mode);
2346       end if;
2347
2348       --  Add the compiling switches for the language specified on the command
2349       --  line, if any.
2350
2351       for J in 1 .. Comp_Opts.Last (Options (Source.Language)) loop
2352          Add_Argument (Options (Source.Language).Table (J), True);
2353       end loop;
2354
2355       --  Finally, add the imported directory switches for this project file
2356       --  (or, for gcc compilers, set up the CPATH env var if needed).
2357
2358       Add_Search_Directories (Data, Source.Language);
2359
2360       --  Set CPATH, if compiler is GCC
2361
2362       if Compiler_Is_Gcc (Source.Language) then
2363          CPATH := Current_Include_Paths (Source.Language);
2364       end if;
2365
2366       --  And invoke the compiler
2367
2368       Display_Command
2369         (Name  => Compiler_Names (Source.Language).all,
2370          Path  => Compiler_Paths (Source.Language),
2371          CPATH => CPATH);
2372
2373       Spawn
2374         (Compiler_Paths (Source.Language).all,
2375          Arguments (1 .. Last_Argument),
2376          Success);
2377
2378       --  Case of successful compilation
2379
2380       if Success then
2381
2382          --  Update the time stamp of the object file
2383
2384          Source.Object_TS := File_Stamp (Source.Object_Name);
2385
2386          --  Do some sanity checks
2387
2388          if Source.Object_TS = Empty_Time_Stamp then
2389             Local_Errors := True;
2390             Report_Error
2391               ("object file ",
2392                Get_Name_String (Source.Object_Name),
2393                " has not been created");
2394
2395          elsif Source.Object_TS < Source.Source_TS then
2396             Local_Errors := True;
2397             Report_Error
2398               ("object file ",
2399                Get_Name_String (Source.Object_Name),
2400                " has not been modified");
2401
2402          else
2403             --  Everything looks fine, update the Other_Sources table
2404
2405             Project_Tree.Other_Sources.Table (Source_Id) := Source;
2406          end if;
2407
2408       --  Compilation failed
2409
2410       else
2411          Local_Errors := True;
2412          Report_Error
2413            ("compilation of ",
2414             Get_Name_String (Source.Path_Name),
2415             " failed");
2416       end if;
2417    end Compile;
2418
2419    --------------------------------
2420    -- Compile_Individual_Sources --
2421    --------------------------------
2422
2423    procedure Compile_Individual_Sources is
2424       Data         : Project_Data :=
2425                        Project_Tree.Projects.Table (Main_Project);
2426       Source_Id    : Other_Source_Id;
2427       Source       : Other_Source;
2428       Source_Name  : File_Name_Type;
2429       Project_Name : String := Get_Name_String (Data.Name);
2430       Dummy        : Boolean := False;
2431
2432       Ada_Is_A_Language : constant Boolean :=
2433                             Data.Languages (Ada_Language_Index);
2434
2435    begin
2436       Ada_Mains.Init;
2437       To_Mixed (Project_Name);
2438       Compile_Only := True;
2439
2440       Get_Imported_Directories (Main_Project, Data);
2441       Project_Tree.Projects.Table (Main_Project) := Data;
2442
2443       --  Compilation will occur in the object directory
2444
2445       if Project_Of_Current_Object_Directory /= Main_Project then
2446          Project_Of_Current_Object_Directory := Main_Project;
2447          Change_Dir (Get_Name_String (Data.Object_Directory));
2448
2449          if Verbose_Mode then
2450             Write_Str  ("Changing to object directory of """);
2451             Write_Name (Data.Name);
2452             Write_Str  (""": """);
2453             Write_Name (Data.Display_Object_Dir);
2454             Write_Line ("""");
2455          end if;
2456       end if;
2457
2458       if not Data.Other_Sources_Present then
2459          if Ada_Is_A_Language then
2460             Mains.Reset;
2461
2462             loop
2463                declare
2464                   Main : constant String := Mains.Next_Main;
2465                begin
2466                   exit when Main'Length = 0;
2467                   Ada_Mains.Increment_Last;
2468                   Ada_Mains.Table (Ada_Mains.Last) := new String'(Main);
2469                end;
2470             end loop;
2471
2472          else
2473             Osint.Fail ("project ", Project_Name, " contains no source");
2474          end if;
2475
2476       else
2477          Mains.Reset;
2478
2479          loop
2480             declare
2481                Main : constant String := Mains.Next_Main;
2482             begin
2483                Name_Len := Main'Length;
2484                exit when Name_Len = 0;
2485                Name_Buffer (1 .. Name_Len) := Main;
2486                Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2487                Source_Name := Name_Find;
2488
2489                if not Sources_Compiled.Get (Source_Name) then
2490                   Sources_Compiled.Set (Source_Name, True);
2491
2492                   Source_Id := Data.First_Other_Source;
2493                   while Source_Id /= No_Other_Source loop
2494                      Source := Project_Tree.Other_Sources.Table (Source_Id);
2495                      exit when Source.File_Name = Source_Name;
2496                      Source_Id := Source.Next;
2497                   end loop;
2498
2499                   if Source_Id = No_Other_Source then
2500                      if Ada_Is_A_Language then
2501                         Ada_Mains.Increment_Last;
2502                         Ada_Mains.Table (Ada_Mains.Last) := new String'(Main);
2503
2504                      else
2505                         Report_Error
2506                           (Main,
2507                            " is not a valid source of project ",
2508                            Project_Name);
2509                      end if;
2510
2511                   else
2512                      Compile (Source_Id, Data, Dummy);
2513                   end if;
2514                end if;
2515             end;
2516          end loop;
2517       end if;
2518
2519       if Ada_Mains.Last > 0 then
2520
2521          --  Invoke gnatmake for all Ada sources
2522
2523          Last_Argument := 0;
2524          Add_Argument (Dash_u, True);
2525
2526          for Index in 1 .. Ada_Mains.Last loop
2527             Add_Argument (Ada_Mains.Table (Index), True);
2528          end loop;
2529
2530          Compile_Link_With_Gnatmake (Mains_Specified => False);
2531       end if;
2532    end Compile_Individual_Sources;
2533
2534    --------------------------------
2535    -- Compile_Link_With_Gnatmake --
2536    --------------------------------
2537
2538    procedure Compile_Link_With_Gnatmake (Mains_Specified : Boolean) is
2539       Data    : constant Project_Data :=
2540                   Project_Tree.Projects.Table (Main_Project);
2541       Success : Boolean;
2542
2543    begin
2544       --  Array Arguments may already contain some arguments, so we don't
2545       --  set Last_Argument to 0.
2546
2547       --  Get the gnatmake to invoke
2548
2549       Get_Compiler (Ada_Language_Index);
2550
2551       --  Specify the project file
2552
2553       Add_Argument (Dash_P, True);
2554       Add_Argument (Get_Name_String (Data.Display_Path_Name), True);
2555
2556       --  Add the saved switches, if any
2557
2558       for Index in 1 .. Saved_Switches.Last loop
2559          Add_Argument (Saved_Switches.Table (Index), True);
2560       end loop;
2561
2562       --  If Mains_Specified is True, find the mains in package Mains
2563
2564       if Mains_Specified then
2565          Mains.Reset;
2566
2567          loop
2568             declare
2569                Main : constant String := Mains.Next_Main;
2570             begin
2571                exit when Main'Length = 0;
2572                Add_Argument (Main, True);
2573             end;
2574          end loop;
2575       end if;
2576
2577       --  Specify output file name, if any was specified on the command line
2578
2579       if Output_File_Name /= null then
2580          Add_Argument (Dash_o, True);
2581          Add_Argument (Output_File_Name, True);
2582       end if;
2583
2584       --  Transmit some switches to gnatmake
2585
2586       --  -c
2587
2588       if Compile_Only then
2589          Add_Argument (Dash_c, True);
2590       end if;
2591
2592       --  -d
2593
2594       if Display_Compilation_Progress then
2595          Add_Argument (Dash_d, True);
2596       end if;
2597
2598       --  -k
2599
2600       if Keep_Going then
2601          Add_Argument (Dash_k, True);
2602       end if;
2603
2604       --  -f
2605
2606       if Force_Compilations then
2607          Add_Argument (Dash_f, True);
2608       end if;
2609
2610       --  -v
2611
2612       if Verbose_Mode then
2613          Add_Argument (Dash_v, True);
2614       end if;
2615
2616       --  -q
2617
2618       if Quiet_Output then
2619          Add_Argument (Dash_q, True);
2620       end if;
2621
2622       --  -vP1 and -vP2
2623
2624       case Current_Verbosity is
2625          when Default =>
2626             null;
2627
2628          when Medium =>
2629             Add_Argument (Dash_vP1, True);
2630
2631          when High =>
2632             Add_Argument (Dash_vP2, True);
2633       end case;
2634
2635       --  If there are compiling options for Ada, transmit them to gnatmake
2636
2637       if Comp_Opts.Last (Options (Ada_Language_Index)) /= 0 then
2638          Add_Argument (Dash_cargs, True);
2639
2640          for Arg in 1 .. Comp_Opts.Last (Options (Ada_Language_Index)) loop
2641             Add_Argument (Options (Ada_Language_Index).Table (Arg), True);
2642          end loop;
2643       end if;
2644
2645       if not Compile_Only then
2646
2647          --  Linking options
2648
2649          if Linker_Options.Last /= 0 then
2650             Add_Argument (Dash_largs, True);
2651          else
2652             Add_Argument (Dash_largs, Verbose_Mode);
2653          end if;
2654
2655          --  Add the archives
2656
2657          Add_Archives (For_Gnatmake => True);
2658
2659          --  If there are linking options from the command line,
2660          --  transmit them to gnatmake.
2661
2662          for Arg in 1 .. Linker_Options.Last loop
2663             Add_Argument (Linker_Options.Table (Arg), True);
2664          end loop;
2665       end if;
2666
2667       --  And invoke gnatmake
2668
2669       Display_Command
2670         (Compiler_Names (Ada_Language_Index).all,
2671          Compiler_Paths (Ada_Language_Index));
2672
2673       Spawn
2674         (Compiler_Paths (Ada_Language_Index).all,
2675          Arguments (1 .. Last_Argument),
2676          Success);
2677
2678       --  Report an error if call to gnatmake failed
2679
2680       if not Success then
2681          Report_Error
2682            ("invocation of ",
2683             Compiler_Names (Ada_Language_Index).all,
2684             " failed");
2685       end if;
2686    end Compile_Link_With_Gnatmake;
2687
2688    ---------------------
2689    -- Compile_Sources --
2690    ---------------------
2691
2692    procedure Compile_Sources is
2693       Data         : Project_Data;
2694       Source_Id    : Other_Source_Id;
2695       Source       : Other_Source;
2696
2697       Local_Errors : Boolean := False;
2698       --  Set to True when there is a compilation error. Used only when
2699       --  Keep_Going is True, to inhibit the building of the archive.
2700
2701       Need_To_Compile : Boolean;
2702       --  Set to True when a source needs to be compiled/recompiled
2703
2704       Need_To_Rebuild_Archive : Boolean := Force_Compilations;
2705       --  True when the archive needs to be built/rebuilt unconditionally
2706
2707       Total_Number_Of_Sources : Int := 0;
2708
2709       Current_Source_Number : Int := 0;
2710
2711    begin
2712       --  First, get the number of sources
2713
2714       for Project in Project_Table.First ..
2715                      Project_Table.Last (Project_Tree.Projects)
2716       loop
2717          Data := Project_Tree.Projects.Table (Project);
2718
2719          if not Data.Virtual and then Data.Other_Sources_Present then
2720             Source_Id := Data.First_Other_Source;
2721             while Source_Id /= No_Other_Source loop
2722                Source := Project_Tree.Other_Sources.Table (Source_Id);
2723                Total_Number_Of_Sources := Total_Number_Of_Sources + 1;
2724                Source_Id := Source.Next;
2725             end loop;
2726          end if;
2727       end loop;
2728
2729       --  Loop through project files
2730
2731       for Project in Project_Table.First ..
2732                      Project_Table.Last (Project_Tree.Projects)
2733       loop
2734          Local_Errors := False;
2735          Data := Project_Tree.Projects.Table (Project);
2736
2737          --  Nothing to do when no sources of language other than Ada
2738
2739          if (not Data.Virtual) and then Data.Other_Sources_Present then
2740
2741             --  If the imported directory switches are unknown, compute them
2742
2743             if not Data.Include_Data_Set then
2744                Get_Imported_Directories (Project, Data);
2745                Data.Include_Data_Set := True;
2746                Project_Tree.Projects.Table (Project) := Data;
2747             end if;
2748
2749             Need_To_Rebuild_Archive := Force_Compilations;
2750
2751             --  Compilation will occur in the object directory
2752
2753             if Project_Of_Current_Object_Directory /= Project then
2754                Project_Of_Current_Object_Directory := Project;
2755                Change_Dir (Get_Name_String (Data.Object_Directory));
2756
2757                if Verbose_Mode then
2758                   Write_Str  ("Changing to object directory of """);
2759                   Write_Name (Data.Display_Name);
2760                   Write_Str  (""": """);
2761                   Write_Name (Data.Display_Object_Dir);
2762                   Write_Line ("""");
2763                end if;
2764             end if;
2765
2766             --  Process each source one by one
2767
2768             Source_Id := Data.First_Other_Source;
2769             while Source_Id /= No_Other_Source loop
2770                Source := Project_Tree.Other_Sources.Table (Source_Id);
2771                Current_Source_Number := Current_Source_Number + 1;
2772                Need_To_Compile := Force_Compilations;
2773
2774                --  Check if compilation is needed
2775
2776                if not Need_To_Compile then
2777                   Check_Compilation_Needed (Source, Need_To_Compile);
2778                end if;
2779
2780                --  Proceed, if compilation is needed
2781
2782                if Need_To_Compile then
2783
2784                   --  If a source is compiled/recompiled, of course the
2785                   --  archive will need to be built/rebuilt.
2786
2787                   Need_To_Rebuild_Archive := True;
2788                   Compile (Source_Id, Data, Local_Errors);
2789                end if;
2790
2791                if Display_Compilation_Progress then
2792                   Write_Str ("completed ");
2793                   Write_Int (Current_Source_Number);
2794                   Write_Str (" out of ");
2795                   Write_Int (Total_Number_Of_Sources);
2796                   Write_Str (" (");
2797                   Write_Int
2798                     ((Current_Source_Number * 100) / Total_Number_Of_Sources);
2799                   Write_Str ("%)...");
2800                   Write_Eol;
2801                end if;
2802
2803                --  Next source, if any
2804
2805                Source_Id := Source.Next;
2806             end loop;
2807
2808             if Need_To_Rebuild_Archive and then (not Data.Library) then
2809                Need_To_Rebuild_Global_Archive := True;
2810             end if;
2811
2812             --  If there was no compilation error and -c was not used,
2813             --  build / rebuild the archive if necessary.
2814
2815             if not Local_Errors
2816               and then Data.Library
2817               and then not Data.Languages (Ada_Language_Index)
2818               and then not Compile_Only
2819             then
2820                Build_Library (Project, Need_To_Rebuild_Archive);
2821             end if;
2822          end if;
2823       end loop;
2824    end Compile_Sources;
2825
2826    ---------------
2827    -- Copyright --
2828    ---------------
2829
2830    procedure Copyright is
2831    begin
2832       --  Only output the Copyright notice once
2833
2834       if not Copyright_Output then
2835          Copyright_Output := True;
2836          Write_Eol;
2837          Write_Str ("GPRMAKE ");
2838          Write_Str (Gnatvsn.Gnat_Version_String);
2839          Write_Str (" Copyright 2004-");
2840          Write_Str (Gnatvsn.Current_Year);
2841          Write_Str (" Free Software Foundation, Inc.");
2842          Write_Eol;
2843       end if;
2844    end Copyright;
2845
2846    ------------------------------------
2847    -- Create_Archive_Dependency_File --
2848    ------------------------------------
2849
2850    procedure Create_Archive_Dependency_File
2851      (Name         : String;
2852       First_Source : Other_Source_Id)
2853    is
2854       Source_Id : Other_Source_Id;
2855       Source    : Other_Source;
2856       Dep_File  : Ada.Text_IO.File_Type;
2857
2858    begin
2859       --  Create the file in Append mode, to avoid automatic insertion of
2860       --  an end of line if file is empty.
2861
2862       Create (Dep_File, Append_File, Name);
2863
2864       Source_Id := First_Source;
2865       while Source_Id /= No_Other_Source loop
2866          Source := Project_Tree.Other_Sources.Table (Source_Id);
2867          Put_Line (Dep_File, Get_Name_String (Source.Object_Name));
2868          Put_Line (Dep_File, String (Source.Object_TS));
2869          Source_Id := Source.Next;
2870       end loop;
2871
2872       Close (Dep_File);
2873
2874    exception
2875       when others =>
2876          if Is_Open (Dep_File) then
2877             Close (Dep_File);
2878          end if;
2879    end Create_Archive_Dependency_File;
2880
2881    -------------------------------------------
2882    -- Create_Global_Archive_Dependency_File --
2883    -------------------------------------------
2884
2885    procedure Create_Global_Archive_Dependency_File (Name : String) is
2886       Source_Id : Other_Source_Id;
2887       Source    : Other_Source;
2888       Dep_File  : Ada.Text_IO.File_Type;
2889
2890    begin
2891       --  Create the file in Append mode, to avoid automatic insertion of
2892       --  an end of line if file is empty.
2893
2894       Create (Dep_File, Append_File, Name);
2895
2896       --  Get all the object files of non-Ada sources in non-library projects
2897
2898       for Project in Project_Table.First ..
2899                      Project_Table.Last (Project_Tree.Projects)
2900       loop
2901          if not Project_Tree.Projects.Table (Project).Library then
2902             Source_Id :=
2903               Project_Tree.Projects.Table (Project).First_Other_Source;
2904             while Source_Id /= No_Other_Source loop
2905                Source := Project_Tree.Other_Sources.Table (Source_Id);
2906
2907                --  Put only those object files that are in the global archive
2908
2909                if Is_Included_In_Global_Archive
2910                     (Source.Object_Name, Project)
2911                then
2912                   Put_Line (Dep_File, Get_Name_String (Source.Object_Path));
2913                   Put_Line (Dep_File, String (Source.Object_TS));
2914                end if;
2915
2916                Source_Id := Source.Next;
2917             end loop;
2918          end if;
2919       end loop;
2920
2921       Close (Dep_File);
2922
2923    exception
2924       when others =>
2925          if Is_Open (Dep_File) then
2926             Close (Dep_File);
2927          end if;
2928    end Create_Global_Archive_Dependency_File;
2929
2930    ---------------------
2931    -- Display_Command --
2932    ---------------------
2933
2934    procedure Display_Command
2935      (Name    : String;
2936       Path    : String_Access;
2937       CPATH   : String_Access := null;
2938       Ellipse : Boolean := False)
2939    is
2940       Display_Ellipse : Boolean := Ellipse;
2941
2942    begin
2943       --  Only display the command in Verbose Mode (-v) or when
2944       --  not in Quiet Output (no -q).
2945
2946       if Verbose_Mode or (not Quiet_Output) then
2947
2948          --  In Verbose Mode output the full path of the spawned process
2949
2950          if Verbose_Mode then
2951             if CPATH /= null then
2952                Write_Str  ("CPATH = ");
2953                Write_Line (CPATH.all);
2954             end if;
2955
2956             Write_Str (Path.all);
2957
2958          else
2959             Write_Str (Name);
2960          end if;
2961
2962          --  Display only the arguments for which the display flag is set
2963          --  (in Verbose Mode, the display flag is set for all arguments)
2964
2965          for Arg in 1 .. Last_Argument loop
2966             if Arguments_Displayed (Arg) then
2967                Write_Char (' ');
2968                Write_Str (Arguments (Arg).all);
2969
2970             elsif Display_Ellipse then
2971                Write_Str (" ...");
2972                Display_Ellipse := False;
2973             end if;
2974          end loop;
2975
2976          Write_Eol;
2977       end if;
2978    end Display_Command;
2979
2980    ------------------
2981    -- Get_Compiler --
2982    ------------------
2983
2984    procedure Get_Compiler (For_Language : First_Language_Indexes) is
2985       Data : constant Project_Data :=
2986                Project_Tree.Projects.Table (Main_Project);
2987
2988       Ide : constant Package_Id :=
2989         Value_Of
2990           (Name_Ide,
2991            In_Packages => Data.Decl.Packages,
2992            In_Tree     => Project_Tree);
2993       --  The id of the package IDE in the project file
2994
2995       Compiler : constant Variable_Value :=
2996         Value_Of
2997           (Name                    => Language_Names.Table (For_Language),
2998            Index                   => 0,
2999            Attribute_Or_Array_Name => Name_Compiler_Command,
3000            In_Package              => Ide,
3001            In_Tree                 => Project_Tree);
3002       --  The value of Compiler_Command ("language") in package IDE, if defined
3003
3004    begin
3005       --  No need to do it again if the compiler is known for this language
3006
3007       if Compiler_Names (For_Language) = null then
3008
3009          --  If compiler command is not defined for this language in package
3010          --  IDE, use the default compiler for this language.
3011
3012          if Compiler = Nil_Variable_Value then
3013             if For_Language in Default_Compiler_Names'Range then
3014                Compiler_Names (For_Language) :=
3015                  Default_Compiler_Names (For_Language);
3016
3017             else
3018                Osint.Fail
3019                  ("unknow compiler name for language """,
3020                   Get_Name_String (Language_Names.Table (For_Language)),
3021                   """");
3022             end if;
3023
3024          else
3025             Compiler_Names (For_Language) :=
3026               new String'(Get_Name_String (Compiler.Value));
3027          end if;
3028
3029          --  Check we have a GCC compiler (name ends with "gcc" or "g++")
3030
3031          declare
3032             Comp_Name : constant String := Compiler_Names (For_Language).all;
3033             Last3     : String (1 .. 3);
3034          begin
3035             if Comp_Name'Length >= 3 then
3036                Last3 := Comp_Name (Comp_Name'Last - 2 .. Comp_Name'Last);
3037                Compiler_Is_Gcc (For_Language) :=
3038                  (Last3 = "gcc") or (Last3 = "g++");
3039             else
3040                Compiler_Is_Gcc (For_Language) := False;
3041             end if;
3042          end;
3043
3044          --  Locate the compiler on the path
3045
3046          Compiler_Paths (For_Language) :=
3047            Locate_Exec_On_Path (Compiler_Names (For_Language).all);
3048
3049          --  Fail if compiler cannot be found
3050
3051          if Compiler_Paths (For_Language) = null then
3052             if For_Language = Ada_Language_Index then
3053                Osint.Fail
3054                  ("unable to locate """,
3055                   Compiler_Names (For_Language).all,
3056                   """");
3057
3058             else
3059                Osint.Fail
3060                  ("unable to locate " &
3061                   Get_Name_String (Language_Names.Table (For_Language)),
3062                   " compiler """, Compiler_Names (For_Language).all & '"');
3063             end if;
3064          end if;
3065       end if;
3066    end Get_Compiler;
3067
3068    ------------------------------
3069    -- Get_Imported_Directories --
3070    ------------------------------
3071
3072    procedure Get_Imported_Directories
3073      (Project : Project_Id;
3074       Data    : in out Project_Data)
3075    is
3076       Imported_Projects : Project_List := Data.Imported_Projects;
3077
3078       Path_Length : Natural := 0;
3079       Position    : Natural := 0;
3080
3081       procedure Add (Source_Dirs : String_List_Id);
3082       --  Add a list of source directories
3083
3084       procedure Recursive_Get_Dirs (Prj : Project_Id);
3085       --  Recursive procedure to get the source directories of this project
3086       --  file and of the project files it imports, in the correct order.
3087
3088       ---------
3089       -- Add --
3090       ---------
3091
3092       procedure Add (Source_Dirs : String_List_Id) is
3093          Element_Id : String_List_Id;
3094          Element    : String_Element;
3095          Add_Arg    : Boolean := True;
3096
3097       begin
3098          --  Add each source directory path name, preceded by "-I" to Arguments
3099
3100          Element_Id := Source_Dirs;
3101          while Element_Id /= Nil_String loop
3102             Element := Project_Tree.String_Elements.Table (Element_Id);
3103
3104             if Element.Value /= No_Name then
3105                Get_Name_String (Element.Display_Value);
3106
3107                if Name_Len > 0 then
3108
3109                   --  Remove a trailing directory separator: this may cause
3110                   --  problems on Windows.
3111
3112                   if Name_Len > 1
3113                     and then Name_Buffer (Name_Len) = Directory_Separator
3114                   then
3115                      Name_Len := Name_Len - 1;
3116                   end if;
3117
3118                   declare
3119                      Arg : constant String :=
3120                              "-I" & Name_Buffer (1 .. Name_Len);
3121                   begin
3122                      --  Check if directory is already in the list. If it is,
3123                      --  no need to put it there again.
3124
3125                      Add_Arg := True;
3126
3127                      for Index in 1 .. Last_Argument loop
3128                         if Arguments (Index).all = Arg then
3129                            Add_Arg := False;
3130                            exit;
3131                         end if;
3132                      end loop;
3133
3134                      if Add_Arg then
3135                         if Path_Length /= 0 then
3136                            Path_Length := Path_Length + 1;
3137                         end if;
3138
3139                         Path_Length := Path_Length + Name_Len;
3140
3141                         Add_Argument (Arg, True);
3142                      end if;
3143                   end;
3144                end if;
3145             end if;
3146
3147             Element_Id := Element.Next;
3148          end loop;
3149       end Add;
3150
3151       ------------------------
3152       -- Recursive_Get_Dirs --
3153       ------------------------
3154
3155       procedure Recursive_Get_Dirs (Prj : Project_Id) is
3156          Data     : Project_Data;
3157          Imported : Project_List;
3158
3159       begin
3160          --  Nothing to do if project is undefined
3161
3162          if Prj /= No_Project then
3163             Data := Project_Tree.Projects.Table (Prj);
3164
3165             --  Nothing to do if project has already been processed
3166
3167             if not Data.Seen then
3168
3169                --  Mark the project as processed, to avoid multiple processing
3170                --  of the same project.
3171
3172                Project_Tree.Projects.Table (Prj).Seen := True;
3173
3174                --  Add the source directories of this project
3175
3176                if not Data.Virtual then
3177                   Add (Data.Source_Dirs);
3178                end if;
3179
3180                Recursive_Get_Dirs (Data.Extends);
3181
3182                --  Call itself for all imported projects, if any
3183
3184                Imported := Data.Imported_Projects;
3185                while Imported /= Empty_Project_List loop
3186                   Recursive_Get_Dirs
3187                     (Project_Tree.Project_Lists.Table (Imported).Project);
3188                   Imported :=
3189                     Project_Tree.Project_Lists.Table (Imported).Next;
3190                end loop;
3191             end if;
3192          end if;
3193       end Recursive_Get_Dirs;
3194
3195    --  Start of processing for Get_Imported_Directories
3196
3197    begin
3198       --  First, mark all project as not processed
3199
3200       for J in Project_Table.First ..
3201                Project_Table.Last (Project_Tree.Projects)
3202       loop
3203          Project_Tree.Projects.Table (J).Seen := False;
3204       end loop;
3205
3206       --  Empty Arguments
3207
3208       Last_Argument := 0;
3209
3210       --  Process this project individually, project data are already known
3211
3212       Project_Tree.Projects.Table (Project).Seen := True;
3213
3214       Add (Data.Source_Dirs);
3215
3216       Recursive_Get_Dirs (Data.Extends);
3217
3218       while Imported_Projects /= Empty_Project_List loop
3219          Recursive_Get_Dirs
3220            (Project_Tree.Project_Lists.Table
3221               (Imported_Projects).Project);
3222          Imported_Projects := Project_Tree.Project_Lists.Table
3223                                 (Imported_Projects).Next;
3224       end loop;
3225
3226       Data.Imported_Directories_Switches :=
3227         new Argument_List'(Arguments (1 .. Last_Argument));
3228
3229       --  Create the Include_Path, from the Arguments
3230
3231       Data.Include_Path := new String (1 .. Path_Length);
3232       Data.Include_Path (1 .. Arguments (1)'Length - 2) :=
3233         Arguments (1)(Arguments (1)'First + 2 .. Arguments (1)'Last);
3234       Position := Arguments (1)'Length - 2;
3235
3236       for Arg in 2 .. Last_Argument loop
3237          Position := Position + 1;
3238          Data.Include_Path (Position) := Path_Separator;
3239          Data.Include_Path
3240            (Position + 1 .. Position + Arguments (Arg)'Length - 2) :=
3241            Arguments (Arg)(Arguments (Arg)'First + 2 .. Arguments (Arg)'Last);
3242          Position := Position + Arguments (Arg)'Length - 2;
3243       end loop;
3244
3245       Last_Argument := 0;
3246    end Get_Imported_Directories;
3247
3248    -------------
3249    -- Gprmake --
3250    -------------
3251
3252    procedure Gprmake is
3253    begin
3254       Makegpr.Initialize;
3255
3256       if Verbose_Mode then
3257          Write_Eol;
3258          Write_Str ("Parsing project file """);
3259          Write_Str (Project_File_Name.all);
3260          Write_Str (""".");
3261          Write_Eol;
3262       end if;
3263
3264       --  Parse and process project files for other languages (not for Ada)
3265
3266       Prj.Pars.Parse
3267         (Project           => Main_Project,
3268          In_Tree           => Project_Tree,
3269          Project_File_Name => Project_File_Name.all,
3270          Packages_To_Check => Packages_To_Check);
3271
3272       --  Fail if parsing/processing was unsuccessful
3273
3274       if Main_Project = No_Project then
3275          Osint.Fail ("""", Project_File_Name.all, """ processing failed");
3276       end if;
3277
3278       if Verbose_Mode then
3279          Write_Eol;
3280          Write_Str ("Parsing of project file """);
3281          Write_Str (Project_File_Name.all);
3282          Write_Str (""" is finished.");
3283          Write_Eol;
3284       end if;
3285
3286       --  If -f was specified, we will certainly need to link (except when
3287       --  -u or -c were specified, of course).
3288
3289       Need_To_Relink := Force_Compilations;
3290
3291       if Unique_Compile then
3292          if Mains.Number_Of_Mains = 0 then
3293             Osint.Fail
3294               ("No source specified to compile in 'unique compile' mode");
3295          else
3296             Compile_Individual_Sources;
3297             Report_Total_Errors ("compilation");
3298          end if;
3299
3300       else
3301          declare
3302             Data : constant Prj.Project_Data :=
3303                      Project_Tree.Projects.Table (Main_Project);
3304          begin
3305             if Data.Library and then Mains.Number_Of_Mains /= 0 then
3306                Osint.Fail
3307                  ("Cannot specify mains on the command line " &
3308                   "for a Library Project");
3309             end if;
3310
3311             --  First check for C++, to link libraries with g++,
3312             --  rather than gcc.
3313
3314             Check_For_C_Plus_Plus;
3315
3316             --  Compile sources and build archives for library project,
3317             --  if necessary.
3318
3319             Compile_Sources;
3320
3321             --  When Keep_Going is True, if we had some errors, fail now,
3322             --  reporting the number of compilation errors.
3323             --  Do not attempt to link.
3324
3325             Report_Total_Errors ("compilation");
3326
3327             --  If -c was not specified, link the executables,
3328             --  if there are any.
3329
3330             if not Compile_Only
3331               and then not Data.Library
3332               and then Data.Object_Directory /= No_Path
3333             then
3334                Build_Global_Archive;
3335                Link_Executables;
3336             end if;
3337
3338             --  When Keep_Going is True, if we had some errors, fail, reporting
3339             --  the number of linking errors.
3340
3341             Report_Total_Errors ("linking");
3342          end;
3343       end if;
3344    end Gprmake;
3345
3346    ----------------
3347    -- Initialize --
3348    ----------------
3349
3350    procedure Initialize is
3351    begin
3352       --  Do some necessary package initializations
3353
3354       Csets.Initialize;
3355       Namet.Initialize;
3356       Snames.Initialize;
3357       Prj.Initialize (Project_Tree);
3358       Mains.Delete;
3359
3360       --  Add the directory where gprmake is invoked in front of the path,
3361       --  if gprmake is invoked from a bin directory or with directory
3362       --  information. information. Only do this if the platform is not VMS,
3363       --  where the notion of path does not really exist.
3364
3365       --  Below code shares nasty code duplication with make.adb code???
3366
3367       if not OpenVMS then
3368          declare
3369             Prefix  : constant String := Executable_Prefix_Path;
3370             Command : constant String := Command_Name;
3371
3372          begin
3373             if Prefix'Length > 0 then
3374                declare
3375                   PATH : constant String :=
3376                            Prefix & Directory_Separator & "bin" &
3377                            Path_Separator &
3378                            Getenv ("PATH").all;
3379                begin
3380                   Setenv ("PATH", PATH);
3381                end;
3382
3383             else
3384                for Index in reverse Command'Range loop
3385                   if Command (Index) = Directory_Separator then
3386                      declare
3387                         Absolute_Dir : constant String :=
3388                                          Normalize_Pathname
3389                                            (Command (Command'First .. Index));
3390                         PATH         : constant String :=
3391                                          Absolute_Dir &
3392                                          Path_Separator &
3393                                          Getenv ("PATH").all;
3394                      begin
3395                         Setenv ("PATH", PATH);
3396                      end;
3397
3398                      exit;
3399                   end if;
3400                end loop;
3401             end if;
3402          end;
3403       end if;
3404
3405       --  Set Name_Ide and Name_Compiler_Command
3406
3407       Name_Len := 0;
3408       Add_Str_To_Name_Buffer ("ide");
3409       Name_Ide := Name_Find;
3410
3411       Name_Len := 0;
3412       Add_Str_To_Name_Buffer ("compiler_command");
3413       Name_Compiler_Command := Name_Find;
3414
3415       --  Make sure the Saved_Switches table is empty
3416
3417       Saved_Switches.Set_Last (0);
3418
3419       --  Get the command line arguments
3420
3421       Scan_Args : for Next_Arg in 1 .. Argument_Count loop
3422          Scan_Arg (Argument (Next_Arg));
3423       end loop Scan_Args;
3424
3425       --  Fail if command line ended with "-P"
3426
3427       if Project_File_Name_Expected then
3428          Osint.Fail ("project file name missing after -P");
3429
3430       --  Or if it ended with "-o"
3431
3432       elsif Output_File_Name_Expected then
3433          Osint.Fail ("output file name missing after -o");
3434       end if;
3435
3436       --  If no project file was specified, display the usage and fail
3437
3438       if Project_File_Name = null then
3439          Usage;
3440          Exit_Program (E_Success);
3441       end if;
3442
3443       --  To be able of finding libgnat.a in MLib.Tgt, we need to have the
3444       --  default search dirs established in Osint.
3445
3446       Osint.Add_Default_Search_Dirs;
3447    end Initialize;
3448
3449    -----------------------------------
3450    -- Is_Included_In_Global_Archive --
3451    -----------------------------------
3452
3453    function Is_Included_In_Global_Archive
3454      (Object_Name : File_Name_Type;
3455       Project     : Project_Id) return Boolean
3456    is
3457       Data   : Project_Data := Project_Tree.Projects.Table (Project);
3458       Source : Other_Source_Id;
3459
3460    begin
3461       while Data.Extended_By /= No_Project loop
3462          Data := Project_Tree.Projects.Table (Data.Extended_By);
3463
3464          Source := Data.First_Other_Source;
3465          while Source /= No_Other_Source loop
3466             if Project_Tree.Other_Sources.Table (Source).Object_Name =
3467                  Object_Name
3468             then
3469                return False;
3470             else
3471                Source :=
3472                  Project_Tree.Other_Sources.Table (Source).Next;
3473             end if;
3474          end loop;
3475       end loop;
3476
3477       return True;
3478    end Is_Included_In_Global_Archive;
3479
3480    ----------------------
3481    -- Link_Executables --
3482    ----------------------
3483
3484    procedure Link_Executables is
3485       Data : constant Project_Data :=
3486                Project_Tree.Projects.Table (Main_Project);
3487
3488       Mains_Specified : constant Boolean := Mains.Number_Of_Mains /= 0;
3489       --  True if main sources were specified on the command line
3490
3491       Object_Dir : constant String :=
3492                      Get_Name_String (Data.Display_Object_Dir);
3493       --  Path of the object directory of the main project
3494
3495       Source_Id : Other_Source_Id;
3496       Source    : Other_Source;
3497       Success   : Boolean;
3498
3499       Linker_Name : String_Access;
3500       Linker_Path : String_Access;
3501       --  The linker name and path, when linking is not done by gnatlink
3502
3503       Link_Done   : Boolean := False;
3504       --  Set to True when the linker is invoked directly (not through
3505       --  gnatmake) to be able to report if mains were up to date at the end
3506       --  of execution.
3507
3508       procedure Add_C_Plus_Plus_Link_For_Gnatmake;
3509       --  Add the --LINK= switch for gnatlink, depending on the C++ compiler
3510
3511       procedure Check_Time_Stamps (Exec_Time_Stamp : Time_Stamp_Type);
3512       --  Check if there is an archive that is more recent than the executable
3513       --  to decide if we need to relink.
3514
3515       procedure Choose_C_Plus_Plus_Link_Process;
3516       --  If the C++ compiler is not g++, create the correct script to link
3517
3518       procedure Link_Foreign
3519         (Main    : String;
3520          Main_Id : File_Name_Type;
3521          Source  : Other_Source);
3522       --  Link a non-Ada main, when there is no Ada code
3523
3524       ---------------------------------------
3525       -- Add_C_Plus_Plus_Link_For_Gnatmake --
3526       ---------------------------------------
3527
3528       procedure Add_C_Plus_Plus_Link_For_Gnatmake is
3529       begin
3530          Add_Argument
3531            ("--LINK=" & Compiler_Names (C_Plus_Plus_Language_Index).all,
3532             Verbose_Mode);
3533       end Add_C_Plus_Plus_Link_For_Gnatmake;
3534
3535       -----------------------
3536       -- Check_Time_Stamps --
3537       -----------------------
3538
3539       procedure Check_Time_Stamps (Exec_Time_Stamp : Time_Stamp_Type) is
3540          Prj_Data : Project_Data;
3541
3542       begin
3543          for Prj in Project_Table.First ..
3544                     Project_Table.Last (Project_Tree.Projects)
3545          loop
3546             Prj_Data := Project_Tree.Projects.Table (Prj);
3547
3548             --  There is an archive only in project
3549             --  files with sources other than Ada
3550             --  sources.
3551
3552             if Data.Other_Sources_Present then
3553                declare
3554                   Archive_Path : constant String := Get_Name_String
3555                     (Prj_Data.Display_Object_Dir) & Directory_Separator
3556                     & "lib" & Get_Name_String (Prj_Data.Display_Name)
3557                     & '.' & Archive_Ext;
3558                   Archive_TS   : Time_Stamp_Type;
3559                begin
3560                   Name_Len := 0;
3561                   Add_Str_To_Name_Buffer (Archive_Path);
3562                   Archive_TS := File_Stamp (File_Name_Type'(Name_Find));
3563
3564                   --  If the archive is later than the
3565                   --  executable, we need to relink.
3566
3567                   if Archive_TS /=  Empty_Time_Stamp
3568                     and then
3569                       Exec_Time_Stamp < Archive_TS
3570                   then
3571                      Need_To_Relink := True;
3572
3573                      if Verbose_Mode then
3574                         Write_Str ("      -> ");
3575                         Write_Str (Archive_Path);
3576                         Write_Str (" has time stamp ");
3577                         Write_Str ("later than ");
3578                         Write_Line ("executable");
3579                      end if;
3580
3581                      exit;
3582                   end if;
3583                end;
3584             end if;
3585          end loop;
3586       end Check_Time_Stamps;
3587
3588       -------------------------------------
3589       -- Choose_C_Plus_Plus_Link_Process --
3590       -------------------------------------
3591
3592       procedure Choose_C_Plus_Plus_Link_Process is
3593       begin
3594          if Compiler_Names (C_Plus_Plus_Language_Index) = null then
3595             Get_Compiler (C_Plus_Plus_Language_Index);
3596          end if;
3597       end Choose_C_Plus_Plus_Link_Process;
3598
3599       ------------------
3600       -- Link_Foreign --
3601       ------------------
3602
3603       procedure Link_Foreign
3604         (Main    : String;
3605          Main_Id : File_Name_Type;
3606          Source  : Other_Source)
3607       is
3608          Executable_Name : constant String :=
3609                              Get_Name_String
3610                                (Executable_Of
3611                                     (Project  => Main_Project,
3612                                      In_Tree  => Project_Tree,
3613                                      Main     => Main_Id,
3614                                      Index    => 0,
3615                                      Ada_Main => False));
3616          --  File name of the executable
3617
3618          Executable_Path : constant String :=
3619                              Get_Name_String
3620                                (Data.Display_Exec_Dir) &
3621                                 Directory_Separator & Executable_Name;
3622          --  Path name of the executable
3623
3624          Exec_Time_Stamp : Time_Stamp_Type;
3625
3626       begin
3627          --  Now, check if the executable is up to date. It is considered
3628          --  up to date if its time stamp is not earlier that the time stamp
3629          --  of any archive. Only do that if we don't know if we need to link.
3630
3631          if not Need_To_Relink then
3632
3633             --  Get the time stamp of the executable
3634
3635             Name_Len := 0;
3636             Add_Str_To_Name_Buffer (Executable_Path);
3637             Exec_Time_Stamp := File_Stamp (File_Name_Type'(Name_Find));
3638
3639             if Verbose_Mode then
3640                Write_Str  ("   Checking executable ");
3641                Write_Line (Executable_Name);
3642             end if;
3643
3644             --  If executable does not exist, we need to link
3645
3646             if Exec_Time_Stamp = Empty_Time_Stamp then
3647                Need_To_Relink := True;
3648
3649                if Verbose_Mode then
3650                   Write_Line ("      -> not found");
3651                end if;
3652
3653             --  Otherwise, get the time stamps of each archive. If one of
3654             --  them is found later than the executable, we need to relink.
3655
3656             else
3657                Check_Time_Stamps (Exec_Time_Stamp);
3658             end if;
3659
3660             --  If Need_To_Relink is False, we are done
3661
3662             if Verbose_Mode and (not Need_To_Relink) then
3663                Write_Line ("      -> up to date");
3664             end if;
3665          end if;
3666
3667          --  Prepare to link
3668
3669          if Need_To_Relink then
3670             Link_Done := True;
3671
3672             Last_Argument := 0;
3673
3674             --  Specify the executable path name
3675
3676             Add_Argument (Dash_o, True);
3677             Add_Argument
3678               (Get_Name_String (Data.Display_Exec_Dir) &
3679                Directory_Separator &
3680                Get_Name_String
3681                  (Executable_Of
3682                     (Project  => Main_Project,
3683                      In_Tree  => Project_Tree,
3684                      Main     => Main_Id,
3685                      Index    => 0,
3686                      Ada_Main => False)),
3687                True);
3688
3689             --  Specify the object file of the main source
3690
3691             Add_Argument
3692               (Object_Dir & Directory_Separator &
3693                Get_Name_String (Source.Object_Name),
3694                True);
3695
3696             --  Add all the archives, in a correct order
3697
3698             Add_Archives (For_Gnatmake => False);
3699
3700             --  Add the switches specified in package Linker of
3701             --  the main project.
3702
3703             Add_Switches
3704               (Data      => Data,
3705                Proc      => Linker,
3706                Language  => Source.Language,
3707                File_Name => Main_Id);
3708
3709             --  Add the switches specified in attribute
3710             --  Linker_Options of packages Linker.
3711
3712             if Link_Options_Switches = null then
3713                Link_Options_Switches :=
3714                  new Argument_List'
3715                    (Linker_Options_Switches (Main_Project, Project_Tree));
3716             end if;
3717
3718             Add_Arguments (Link_Options_Switches.all, True);
3719
3720             --  Add the linking options specified on the
3721             --  command line.
3722
3723             for Arg in 1 .. Linker_Options.Last loop
3724                Add_Argument (Linker_Options.Table (Arg), True);
3725             end loop;
3726
3727             --  If there are shared libraries and the run path
3728             --  option is supported, add the run path switch.
3729
3730             if Lib_Path.Last > 0 then
3731                Add_Argument
3732                  (Path_Option.all &
3733                   String (Lib_Path.Table (1 .. Lib_Path.Last)),
3734                   Verbose_Mode);
3735             end if;
3736
3737             --  And invoke the linker
3738
3739             Display_Command (Linker_Name.all, Linker_Path);
3740             Spawn
3741               (Linker_Path.all,
3742                Arguments (1 .. Last_Argument),
3743                Success);
3744
3745             if not Success then
3746                Report_Error ("could not link ", Main);
3747             end if;
3748          end if;
3749       end Link_Foreign;
3750
3751    --  Start of processing of Link_Executables
3752
3753    begin
3754       --  If no mains specified, get mains from attribute Main, if it exists
3755
3756       if not Mains_Specified then
3757          declare
3758             Element_Id : String_List_Id;
3759             Element    : String_Element;
3760
3761          begin
3762             Element_Id := Data.Mains;
3763             while Element_Id /= Nil_String loop
3764                Element := Project_Tree.String_Elements.Table (Element_Id);
3765
3766                if Element.Value /= No_Name then
3767                   Mains.Add_Main (Get_Name_String (Element.Value));
3768                end if;
3769
3770                Element_Id := Element.Next;
3771             end loop;
3772          end;
3773       end if;
3774
3775       if Mains.Number_Of_Mains = 0 then
3776
3777          --  If the attribute Main is an empty list or not specified,
3778          --  there is nothing to do.
3779
3780          if Verbose_Mode then
3781             Write_Line ("No main to link");
3782          end if;
3783          return;
3784       end if;
3785
3786       --  Check if -o was used for several mains
3787
3788       if Output_File_Name /= null and then Mains.Number_Of_Mains > 1 then
3789          Osint.Fail ("cannot specify an executable name for several mains");
3790       end if;
3791
3792       --  Check how we are going to do the link
3793
3794       if not Data.Other_Sources_Present then
3795
3796          --  Only Ada sources in the main project, and even maybe not
3797
3798          if not Data.Languages (Ada_Language_Index) then
3799
3800             --  Fail if the main project has no source of any language
3801
3802             Osint.Fail
3803               ("project """,
3804                Get_Name_String (Data.Name),
3805                """ has no sources, so no main can be linked");
3806
3807          else
3808             --  Only Ada sources in the main project, call gnatmake directly
3809
3810             Last_Argument := 0;
3811
3812             --  Choose correct linker if there is C++ code in other projects
3813
3814             if C_Plus_Plus_Is_Used then
3815                Choose_C_Plus_Plus_Link_Process;
3816                Add_Argument (Dash_largs, Verbose_Mode);
3817                Add_C_Plus_Plus_Link_For_Gnatmake;
3818                Add_Argument (Dash_margs, Verbose_Mode);
3819             end if;
3820
3821             Compile_Link_With_Gnatmake (Mains_Specified);
3822          end if;
3823
3824       else
3825          --  There are other language sources. First check if there are also
3826          --  sources in Ada.
3827
3828          if Data.Languages (Ada_Language_Index) then
3829
3830             --  There is a mix of Ada and other language sources in the main
3831             --  project. Any main that is not a source of the other languages
3832             --  will be deemed to be an Ada main.
3833
3834             --  Find the mains of the other languages and the Ada mains
3835
3836             Mains.Reset;
3837             Ada_Mains.Set_Last (0);
3838             Other_Mains.Set_Last (0);
3839
3840             --  For each main
3841
3842             loop
3843                declare
3844                   Main    : constant String := Mains.Next_Main;
3845                   Main_Id : File_Name_Type;
3846
3847                begin
3848                   exit when Main'Length = 0;
3849
3850                   --  Get the main file name
3851
3852                   Name_Len := 0;
3853                   Add_Str_To_Name_Buffer (Main);
3854                   Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3855                   Main_Id := Name_Find;
3856
3857                   --  Check if it is a source of a language other than Ada
3858
3859                   Source_Id := Data.First_Other_Source;
3860                   while Source_Id /= No_Other_Source loop
3861                      Source :=
3862                        Project_Tree.Other_Sources.Table (Source_Id);
3863                      exit when Source.File_Name = Main_Id;
3864                      Source_Id := Source.Next;
3865                   end loop;
3866
3867                   --  If it is not, put it in the list of Ada mains
3868
3869                   if Source_Id = No_Other_Source then
3870                      Ada_Mains.Increment_Last;
3871                      Ada_Mains.Table (Ada_Mains.Last) := new String'(Main);
3872
3873                   --  Otherwise, put it in the list of other mains
3874
3875                   else
3876                      Other_Mains.Increment_Last;
3877                      Other_Mains.Table (Other_Mains.Last) := Source;
3878                   end if;
3879                end;
3880             end loop;
3881
3882             --  If C++ is one of the other language, create the shell script
3883             --  to do the link.
3884
3885             if C_Plus_Plus_Is_Used then
3886                Choose_C_Plus_Plus_Link_Process;
3887             end if;
3888
3889             --  Call gnatmake with the necessary switches for each non-Ada
3890             --  main, if there are some.
3891
3892             for Main in 1 .. Other_Mains.Last loop
3893                declare
3894                   Source : constant Other_Source := Other_Mains.Table (Main);
3895
3896                begin
3897                   Last_Argument := 0;
3898
3899                   --  Add -o if -o was specified
3900
3901                   if Output_File_Name = null then
3902                      Add_Argument (Dash_o, True);
3903                      Add_Argument
3904                        (Get_Name_String
3905                           (Executable_Of
3906                              (Project  => Main_Project,
3907                               In_Tree  => Project_Tree,
3908                               Main     => Other_Mains.Table (Main).File_Name,
3909                               Index    => 0,
3910                               Ada_Main => False)),
3911                         True);
3912                   end if;
3913
3914                   --  Call gnatmake with the -B switch
3915
3916                   Add_Argument (Dash_B, True);
3917
3918                   --  Add to the linking options the object file of the source
3919
3920                   Add_Argument (Dash_largs, Verbose_Mode);
3921                   Add_Argument
3922                     (Get_Name_String (Source.Object_Name), Verbose_Mode);
3923
3924                   --  If C++ is one of the language, add the --LINK switch
3925                   --  to the linking switches.
3926
3927                   if C_Plus_Plus_Is_Used then
3928                      Add_C_Plus_Plus_Link_For_Gnatmake;
3929                   end if;
3930
3931                   --  Add -margs so that the following switches are for
3932                   --  gnatmake
3933
3934                   Add_Argument (Dash_margs, Verbose_Mode);
3935
3936                   --  And link with gnatmake
3937
3938                   Compile_Link_With_Gnatmake (Mains_Specified => False);
3939                end;
3940             end loop;
3941
3942             --  If there are also Ada mains, call gnatmake for all these mains
3943
3944             if Ada_Mains.Last /= 0 then
3945                Last_Argument := 0;
3946
3947                --  Put all the Ada mains as the first arguments
3948
3949                for Main in 1 .. Ada_Mains.Last loop
3950                   Add_Argument (Ada_Mains.Table (Main).all, True);
3951                end loop;
3952
3953                --  If C++ is one of the languages, add the --LINK switch to
3954                --  the linking switches.
3955
3956                if Data.Languages (C_Plus_Plus_Language_Index) then
3957                   Add_Argument (Dash_largs, Verbose_Mode);
3958                   Add_C_Plus_Plus_Link_For_Gnatmake;
3959                   Add_Argument (Dash_margs, Verbose_Mode);
3960                end if;
3961
3962                --  And link with gnatmake
3963
3964                Compile_Link_With_Gnatmake (Mains_Specified => False);
3965             end if;
3966
3967          else
3968             --  No Ada source in main project
3969
3970             --  First, get the linker to invoke
3971
3972             if Data.Languages (C_Plus_Plus_Language_Index) then
3973                Get_Compiler (C_Plus_Plus_Language_Index);
3974                Linker_Name := Compiler_Names (C_Plus_Plus_Language_Index);
3975                Linker_Path := Compiler_Paths (C_Plus_Plus_Language_Index);
3976
3977             else
3978                Get_Compiler (C_Language_Index);
3979                Linker_Name := Compiler_Names (C_Language_Index);
3980                Linker_Path := Compiler_Paths (C_Language_Index);
3981             end if;
3982
3983             Link_Done := False;
3984
3985             Mains.Reset;
3986
3987             --  Get each main, check if it is a source of the main project,
3988             --  and if it is, invoke the linker.
3989
3990             loop
3991                declare
3992                   Main    : constant String := Mains.Next_Main;
3993                   Main_Id : File_Name_Type;
3994
3995                begin
3996                   exit when Main'Length = 0;
3997
3998                   --  Get the file name of the main
3999
4000                   Name_Len := 0;
4001                   Add_Str_To_Name_Buffer (Main);
4002                   Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
4003                   Main_Id := Name_Find;
4004
4005                   --  Check if it is a source of the main project file
4006
4007                   Source_Id := Data.First_Other_Source;
4008                   while Source_Id /= No_Other_Source loop
4009                      Source :=
4010                        Project_Tree.Other_Sources.Table (Source_Id);
4011                      exit when Source.File_Name = Main_Id;
4012                      Source_Id := Source.Next;
4013                   end loop;
4014
4015                   --  Report an error if it is not
4016
4017                   if Source_Id = No_Other_Source then
4018                      Report_Error
4019                        (Main, "is not a source of project ",
4020                         Get_Name_String (Data.Name));
4021
4022                   else
4023                      Link_Foreign (Main, Main_Id, Source);
4024                   end if;
4025                end;
4026             end loop;
4027
4028             --  If no linking was done, report it, except in Quiet Output
4029
4030             if (Verbose_Mode or (not Quiet_Output)) and (not Link_Done) then
4031                Osint.Write_Program_Name;
4032
4033                if Mains.Number_Of_Mains = 1 then
4034
4035                   --  If there is only one executable, report its name too
4036
4037                   Write_Str (": """);
4038                   Mains.Reset;
4039
4040                   declare
4041                      Main    : constant String := Mains.Next_Main;
4042                      Main_Id : File_Name_Type;
4043                   begin
4044                      Name_Len := 0;
4045                      Add_Str_To_Name_Buffer (Main);
4046                      Main_Id := Name_Find;
4047                      Write_Str
4048                        (Get_Name_String
4049                           (Executable_Of
4050                              (Project  => Main_Project,
4051                               In_Tree  => Project_Tree,
4052                               Main     => Main_Id,
4053                               Index    => 0,
4054                               Ada_Main => False)));
4055                      Write_Line (""" up to date");
4056                   end;
4057
4058                else
4059                   Write_Line (": all executables up to date");
4060                end if;
4061             end if;
4062          end if;
4063       end if;
4064    end Link_Executables;
4065
4066    ------------------
4067    -- Report_Error --
4068    ------------------
4069
4070    procedure Report_Error
4071      (S1 : String;
4072       S2 : String := "";
4073       S3 : String := "")
4074    is
4075    begin
4076       --  If Keep_Going is True, output error message preceded by error header
4077
4078       if Keep_Going then
4079          Total_Number_Of_Errors := Total_Number_Of_Errors + 1;
4080          Write_Str (Error_Header);
4081          Write_Str (S1);
4082          Write_Str (S2);
4083          Write_Str (S3);
4084          Write_Eol;
4085
4086       --  Otherwise just fail
4087
4088       else
4089          Osint.Fail (S1, S2, S3);
4090       end if;
4091    end Report_Error;
4092
4093    -------------------------
4094    -- Report_Total_Errors --
4095    -------------------------
4096
4097    procedure Report_Total_Errors (Kind : String) is
4098    begin
4099       if Total_Number_Of_Errors /= 0 then
4100          if Total_Number_Of_Errors = 1 then
4101             Osint.Fail
4102               ("One ", Kind, " error");
4103
4104          else
4105             Osint.Fail
4106               ("Total of" & Total_Number_Of_Errors'Img,
4107                ' ' & Kind & " errors");
4108          end if;
4109       end if;
4110    end Report_Total_Errors;
4111
4112    --------------
4113    -- Scan_Arg --
4114    --------------
4115
4116    procedure Scan_Arg (Arg : String) is
4117    begin
4118       pragma Assert (Arg'First = 1);
4119
4120       if Arg'Length = 0 then
4121          return;
4122       end if;
4123
4124       --  If preceding switch was -P, a project file name need to be
4125       --  specified, not a switch.
4126
4127       if Project_File_Name_Expected then
4128          if Arg (1) = '-' then
4129             Osint.Fail ("project file name missing after -P");
4130          else
4131             Project_File_Name_Expected := False;
4132             Project_File_Name := new String'(Arg);
4133          end if;
4134
4135       --  If preceding switch was -o, an executable name need to be
4136       --  specified, not a switch.
4137
4138       elsif Output_File_Name_Expected then
4139          if Arg (1) = '-' then
4140             Osint.Fail ("output file name missing after -o");
4141          else
4142             Output_File_Name_Expected := False;
4143             Output_File_Name := new String'(Arg);
4144          end if;
4145
4146       --  Set the processor/language for the following switches
4147
4148       --  -cargs: Ada compiler arguments
4149
4150       elsif Arg = "-cargs" then
4151          Current_Language  := Ada_Language_Index;
4152          Current_Processor := Compiler;
4153
4154       elsif Arg'Length > 7 and then Arg (1 .. 7) = "-cargs:" then
4155          Name_Len := 0;
4156          Add_Str_To_Name_Buffer (Arg (8 .. Arg'Last));
4157          To_Lower (Name_Buffer (1 .. Name_Len));
4158
4159          declare
4160             Lang : constant Name_Id := Name_Find;
4161          begin
4162             Current_Language := Language_Indexes.Get (Lang);
4163
4164             if Current_Language = No_Language_Index then
4165                Add_Language_Name (Lang);
4166                Current_Language := Last_Language_Index;
4167             end if;
4168
4169             Current_Processor := Compiler;
4170          end;
4171
4172       elsif Arg = "-largs" then
4173          Current_Processor := Linker;
4174
4175       --  -gargs: gprmake
4176
4177       elsif Arg = "-gargs" then
4178          Current_Processor := None;
4179
4180       --  A special test is needed for the -o switch within a -largs since
4181       --  that is another way to specify the name of the final executable.
4182
4183       elsif Current_Processor = Linker and then Arg = "-o" then
4184          Osint.Fail
4185            ("switch -o not allowed within a -largs. Use -o directly.");
4186
4187       --  If current processor is not gprmake directly, store the option in
4188       --  the appropriate table.
4189
4190       elsif Current_Processor /= None then
4191          Add_Option (Arg);
4192
4193       --  Switches start with '-'
4194
4195       elsif Arg (1) = '-' then
4196          if Arg'Length > 3 and then Arg (1 .. 3) = "-aP" then
4197             Add_Search_Project_Directory (Arg (4 .. Arg'Last));
4198
4199             --  Record the switch, so that it is passed to gnatmake, if
4200             --  gnatmake is called.
4201
4202             Saved_Switches.Append (new String'(Arg));
4203
4204          elsif Arg = "-c" then
4205             Compile_Only := True;
4206
4207             --  Make sure that when a main is specified and switch -c is used,
4208             --  only the main(s) is/are compiled.
4209
4210             if Mains.Number_Of_Mains > 0 then
4211                Unique_Compile := True;
4212             end if;
4213
4214          elsif Arg = "-d" then
4215             Display_Compilation_Progress := True;
4216
4217          elsif Arg = "-f" then
4218             Force_Compilations := True;
4219
4220          elsif Arg = "-h" then
4221             Usage;
4222
4223          elsif Arg = "-k" then
4224             Keep_Going := True;
4225
4226          elsif Arg = "-o" then
4227             if Output_File_Name /= null then
4228                Osint.Fail ("cannot specify several -o switches");
4229
4230             else
4231                Output_File_Name_Expected := True;
4232             end if;
4233
4234          elsif Arg'Length >= 2 and then Arg (2) = 'P' then
4235             if Project_File_Name /= null then
4236                Osint.Fail ("cannot have several project files specified");
4237
4238             elsif Arg'Length = 2 then
4239                Project_File_Name_Expected := True;
4240
4241             else
4242                Project_File_Name := new String'(Arg (3 .. Arg'Last));
4243             end if;
4244
4245          elsif Arg = "-p" or else Arg = "--create-missing-dirs" then
4246             Setup_Projects := True;
4247
4248          elsif Arg = "-q" then
4249             Quiet_Output := True;
4250
4251          elsif Arg = "-u" then
4252             Unique_Compile := True;
4253             Compile_Only   := True;
4254
4255          elsif Arg = "-v" then
4256             Verbose_Mode := True;
4257             Copyright;
4258
4259          elsif Arg'Length = 4 and then Arg (1 .. 3) = "-vP"
4260            and then Arg (4) in '0' .. '2'
4261          then
4262             case Arg (4) is
4263                when '0' =>
4264                   Current_Verbosity := Prj.Default;
4265                when '1' =>
4266                   Current_Verbosity := Prj.Medium;
4267                when '2' =>
4268                   Current_Verbosity := Prj.High;
4269                when others =>
4270                   null;
4271             end case;
4272
4273          elsif Arg'Length >= 3 and then Arg (2) = 'X'
4274            and then Is_External_Assignment (Arg)
4275          then
4276             --  Is_External_Assignment has side effects when it returns True
4277
4278             --  Record the -X switch, so that it will be passed to gnatmake,
4279             --  if gnatmake is called.
4280
4281             Saved_Switches.Append (new String'(Arg));
4282
4283          else
4284             Osint.Fail ("illegal option """, Arg, """");
4285          end if;
4286
4287       else
4288          --  Not a switch: must be a main
4289
4290          Mains.Add_Main (Arg);
4291
4292          --  Make sure that when a main is specified and switch -c is used,
4293          --  only the main(s) is/are compiled.
4294
4295          if Compile_Only then
4296             Unique_Compile := True;
4297          end if;
4298       end if;
4299    end Scan_Arg;
4300
4301    -----------------
4302    -- Strip_CR_LF --
4303    -----------------
4304
4305    function Strip_CR_LF (Text : String) return String is
4306       To       : String (1 .. Text'Length);
4307       Index_To : Natural := 0;
4308
4309    begin
4310       for Index in Text'Range loop
4311          if (Text (Index) /= ASCII.CR) and then (Text (Index) /= ASCII.LF) then
4312             Index_To := Index_To + 1;
4313             To (Index_To) := Text (Index);
4314          end if;
4315       end loop;
4316
4317       return To (1 .. Index_To);
4318    end Strip_CR_LF;
4319
4320    -----------
4321    -- Usage --
4322    -----------
4323
4324    procedure Usage is
4325    begin
4326       if not Usage_Output then
4327          Usage_Output := True;
4328          Copyright;
4329
4330          Write_Str ("Usage: ");
4331          Osint.Write_Program_Name;
4332          Write_Str (" -P<project file> [opts]  [name] {");
4333          Write_Str ("[-cargs:lang opts] ");
4334          Write_Str ("[-largs opts] [-gargs opts]}");
4335          Write_Eol;
4336          Write_Eol;
4337          Write_Str ("  name is zero or more file names");
4338          Write_Eol;
4339          Write_Eol;
4340
4341          --  GPRMAKE switches
4342
4343          Write_Str ("gprmake switches:");
4344          Write_Eol;
4345
4346          --  Line for -aP
4347
4348          Write_Str ("  -aPdir   Add directory dir to project search path");
4349          Write_Eol;
4350
4351          --  Line for -c
4352
4353          Write_Str ("  -c       Compile only");
4354          Write_Eol;
4355
4356          --  Line for -f
4357
4358          Write_Str ("  -f       Force recompilations");
4359          Write_Eol;
4360
4361          --  Line for -k
4362
4363          Write_Str ("  -k       Keep going after compilation errors");
4364          Write_Eol;
4365
4366          --  Line for -o
4367
4368          Write_Str ("  -o name  Choose an alternate executable name");
4369          Write_Eol;
4370
4371          --  Line for -p
4372
4373          Write_Str ("  -p       Create missing obj, lib and exec dirs");
4374          Write_Eol;
4375
4376          --  Line for -P
4377
4378          Write_Str ("  -Pproj   Use GNAT Project File proj");
4379          Write_Eol;
4380
4381          --  Line for -q
4382
4383          Write_Str ("  -q       Be quiet/terse");
4384          Write_Eol;
4385
4386          --  Line for -u
4387
4388          Write_Str
4389            ("  -u       Unique compilation. Only compile the given files");
4390          Write_Eol;
4391
4392          --  Line for -v
4393
4394          Write_Str ("  -v       Verbose output");
4395          Write_Eol;
4396
4397          --  Line for -vPx
4398
4399          Write_Str ("  -vPx     Specify verbosity when parsing Project Files");
4400          Write_Eol;
4401
4402          --  Line for -X
4403
4404          Write_Str ("  -Xnm=val Specify an external reference for " &
4405                     "Project Files");
4406          Write_Eol;
4407          Write_Eol;
4408
4409          --  Line for -cargs
4410
4411          Write_Line ("  -cargs opts     opts are passed to the Ada compiler");
4412
4413          --  Line for -cargs:lang
4414
4415          Write_Line ("  -cargs:<lang> opts");
4416          Write_Line ("     opts are passed to the compiler " &
4417                      "for language < lang > ");
4418
4419          --  Line for -largs
4420
4421          Write_Str ("  -largs opts    opts are passed to the linker");
4422          Write_Eol;
4423
4424          --  Line for -gargs
4425
4426          Write_Str ("  -gargs opts    opts directly interpreted by gprmake");
4427          Write_Eol;
4428          Write_Eol;
4429
4430       end if;
4431    end Usage;
4432
4433 begin
4434    Makeutl.Do_Fail := Report_Error'Access;
4435 end Makegpr;