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