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-2005 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             use Ada.Text_IO;
1692          begin
1693             Create (Archive, Out_File, Archive_Name);
1694             Close (Archive);
1695          end;
1696
1697          Create_Archive_Dependency_File
1698            (Archive_Dep_Name, Data.First_Other_Source);
1699       end if;
1700    end Build_Library;
1701
1702    -----------
1703    -- Check --
1704    -----------
1705
1706    procedure Check (Option : String) is
1707       First : Positive := Option'First;
1708       Last  : Natural;
1709
1710    begin
1711       for Index in Option'First + 1 .. Option'Last - 1 loop
1712          if Option (Index) = ' ' and then Option (Index + 1) = '-' then
1713             Write_Str ("warning: switch """);
1714             Write_Str (Option);
1715             Write_Str (""" is suspicious; consider using ");
1716
1717             Last := First;
1718             while Last <= Option'Last loop
1719                if Option (Last) = ' ' then
1720                   if First /= Option'First then
1721                      Write_Str (", ");
1722                   end if;
1723
1724                   Write_Char ('"');
1725                   Write_Str (Option (First .. Last - 1));
1726                   Write_Char ('"');
1727
1728                   while Last <= Option'Last and then Option (Last) = ' ' loop
1729                      Last := Last + 1;
1730                   end loop;
1731
1732                   First := Last;
1733
1734                else
1735                   if Last = Option'Last then
1736                      if First /= Option'First then
1737                         Write_Str (", ");
1738                      end if;
1739
1740                      Write_Char ('"');
1741                      Write_Str (Option (First .. Last));
1742                      Write_Char ('"');
1743                   end if;
1744
1745                   Last := Last + 1;
1746                end if;
1747             end loop;
1748
1749             Write_Line (" instead");
1750             exit;
1751          end if;
1752       end loop;
1753    end Check;
1754
1755    ---------------------------
1756    -- Check_Archive_Builder --
1757    ---------------------------
1758
1759    procedure Check_Archive_Builder is
1760    begin
1761       --  First, make sure that the archive builder (ar) is on the path
1762
1763       if Archive_Builder_Path = null then
1764          Archive_Builder_Path := Locate_Exec_On_Path (Archive_Builder);
1765
1766          if Archive_Builder_Path = null then
1767             Osint.Fail
1768               ("unable to locate archive builder """,
1769                Archive_Builder,
1770                """");
1771          end if;
1772
1773          --  If there is an archive indexer (ranlib), try to locate it on the
1774          --  path. Don't fail if it is not found.
1775
1776          if Archive_Indexer /= "" then
1777             Archive_Indexer_Path := Locate_Exec_On_Path (Archive_Indexer);
1778          end if;
1779       end if;
1780    end Check_Archive_Builder;
1781
1782    ------------------------------
1783    -- Check_Compilation_Needed --
1784    ------------------------------
1785
1786    procedure Check_Compilation_Needed
1787      (Source          : Other_Source;
1788       Need_To_Compile : out Boolean)
1789    is
1790       Source_Name : constant String := Get_Name_String (Source.File_Name);
1791       Source_Path : constant String := Get_Name_String (Source.Path_Name);
1792       Object_Name : constant String := Get_Name_String (Source.Object_Name);
1793       Dep_Name    : constant String := Get_Name_String (Source.Dep_Name);
1794
1795       Source_In_Dependencies : Boolean := False;
1796       --  Set True if source was found in dependency file of its object file
1797
1798       Dep_File : Prj.Util.Text_File;
1799       Start    : Natural;
1800       Finish   : Natural;
1801
1802    begin
1803       --  Assume the worst, so that statement "return;" may be used if there
1804       --  is any problem.
1805
1806       Need_To_Compile := True;
1807
1808       if Verbose_Mode then
1809          Write_Str  ("   Checking ");
1810          Write_Str  (Source_Name);
1811          Write_Line (" ... ");
1812       end if;
1813
1814       --  If object file does not exist, of course source need to be compiled
1815
1816       if Source.Object_TS = Empty_Time_Stamp then
1817          if Verbose_Mode then
1818             Write_Str  ("      -> object file ");
1819             Write_Str  (Object_Name);
1820             Write_Line (" does not exist");
1821          end if;
1822
1823          return;
1824       end if;
1825
1826       --  If the object file has been created before the last modification
1827       --  of the source, the source need to be recompiled.
1828
1829       if Source.Object_TS < Source.Source_TS then
1830          if Verbose_Mode then
1831             Write_Str  ("      -> object file ");
1832             Write_Str  (Object_Name);
1833             Write_Line (" has time stamp earlier than source");
1834          end if;
1835
1836          return;
1837       end if;
1838
1839       --  If there is no dependency file, then the source needs to be
1840       --  recompiled and the dependency file need to be created.
1841
1842       if Source.Dep_TS = Empty_Time_Stamp then
1843          if Verbose_Mode then
1844             Write_Str  ("      -> dependency file ");
1845             Write_Str  (Dep_Name);
1846             Write_Line (" does not exist");
1847          end if;
1848
1849          return;
1850       end if;
1851
1852       --  The source needs to be recompiled if the source has been modified
1853       --  after the dependency file has been created.
1854
1855       if Source.Dep_TS < Source.Source_TS then
1856          if Verbose_Mode then
1857             Write_Str  ("      -> dependency file ");
1858             Write_Str  (Dep_Name);
1859             Write_Line (" has time stamp earlier than source");
1860          end if;
1861
1862          return;
1863       end if;
1864
1865       --  Look for all dependencies
1866
1867       Open (Dep_File, Dep_Name);
1868
1869       --  If dependency file cannot be open, we need to recompile the source
1870
1871       if not Is_Valid (Dep_File) then
1872          if Verbose_Mode then
1873             Write_Str  ("      -> could not open dependency file ");
1874             Write_Line (Dep_Name);
1875          end if;
1876
1877          return;
1878       end if;
1879
1880       declare
1881          End_Of_File_Reached : Boolean := False;
1882
1883       begin
1884          loop
1885             if End_Of_File (Dep_File) then
1886                End_Of_File_Reached := True;
1887                exit;
1888             end if;
1889
1890             Get_Line (Dep_File, Name_Buffer, Name_Len);
1891
1892             exit when Name_Len > 0 and then Name_Buffer (1) /= '#';
1893          end loop;
1894
1895          --  If dependency file contains only empty lines or comments, then
1896          --  dependencies are unknown, and the source needs to be recompiled.
1897
1898          if End_Of_File_Reached then
1899             if Verbose_Mode then
1900                Write_Str  ("      -> dependency file ");
1901                Write_Str  (Dep_Name);
1902                Write_Line (" is empty");
1903             end if;
1904
1905             Close (Dep_File);
1906             return;
1907          end if;
1908       end;
1909
1910       Start  := 1;
1911       Finish := Index (Name_Buffer (1 .. Name_Len), ": ");
1912
1913       --  First line must start with name of object file, followed by colon
1914
1915       if Finish = 0 or else Name_Buffer (1 .. Finish - 1) /= Object_Name then
1916          if Verbose_Mode then
1917             Write_Str  ("      -> dependency file ");
1918             Write_Str  (Dep_Name);
1919             Write_Line (" has wrong format");
1920          end if;
1921
1922          Close (Dep_File);
1923          return;
1924
1925       else
1926          Start := Finish + 2;
1927
1928          --  Process each line
1929
1930          Line_Loop : loop
1931             declare
1932                Line : constant String  := Name_Buffer (1 .. Name_Len);
1933                Last : constant Natural := Name_Len;
1934
1935             begin
1936                Name_Loop : loop
1937
1938                   --  Find the beginning of the next source path name
1939
1940                   while Start < Last and then Line (Start) = ' ' loop
1941                      Start := Start + 1;
1942                   end loop;
1943
1944                   --  Go to next line when there is a continuation character \
1945                   --  at the end of the line.
1946
1947                   exit Name_Loop when Start = Last
1948                                    and then Line (Start) = '\';
1949
1950                   --  We should not be at the end of the line, without
1951                   --  a continuation character \.
1952
1953                   if Start = Last then
1954                      if Verbose_Mode then
1955                         Write_Str  ("      -> dependency file ");
1956                         Write_Str  (Dep_Name);
1957                         Write_Line (" has wrong format");
1958                      end if;
1959
1960                      Close (Dep_File);
1961                      return;
1962                   end if;
1963
1964                   --  Look for the end of the source path name
1965
1966                   Finish := Start;
1967                   while Finish < Last and then Line (Finish + 1) /= ' ' loop
1968                      Finish := Finish + 1;
1969                   end loop;
1970
1971                   --  Check this source
1972
1973                   declare
1974                      Src_Name : constant String :=
1975                                   Normalize_Pathname
1976                                     (Name           => Line (Start .. Finish),
1977                                      Case_Sensitive => False);
1978                      Src_TS   : Time_Stamp_Type;
1979
1980                   begin
1981                      --  If it is original source, set Source_In_Dependencies
1982
1983                      if Src_Name = Source_Path then
1984                         Source_In_Dependencies := True;
1985                      end if;
1986
1987                      Name_Len := 0;
1988                      Add_Str_To_Name_Buffer (Src_Name);
1989                      Src_TS := File_Stamp (Name_Find);
1990
1991                      --  If the source does not exist, we need to recompile
1992
1993                      if Src_TS = Empty_Time_Stamp then
1994                         if Verbose_Mode then
1995                            Write_Str  ("      -> source ");
1996                            Write_Str  (Src_Name);
1997                            Write_Line (" does not exist");
1998                         end if;
1999
2000                         Close (Dep_File);
2001                         return;
2002
2003                      --  If the source has been modified after the object file,
2004                      --  we need to recompile.
2005
2006                      elsif Src_TS > Source.Object_TS then
2007                         if Verbose_Mode then
2008                            Write_Str  ("      -> source ");
2009                            Write_Str  (Src_Name);
2010                            Write_Line
2011                              (" has time stamp later than object file");
2012                         end if;
2013
2014                         Close (Dep_File);
2015                         return;
2016                      end if;
2017                   end;
2018
2019                   --  If the source path name ends the line, we are done.
2020
2021                   exit Line_Loop when Finish = Last;
2022
2023                   --  Go get the next source on the line
2024
2025                   Start := Finish + 1;
2026                end loop Name_Loop;
2027             end;
2028
2029             --  If we are here, we had a continuation character \ at the end
2030             --  of the line, so we continue with the next line.
2031
2032             Get_Line (Dep_File, Name_Buffer, Name_Len);
2033             Start := 1;
2034          end loop Line_Loop;
2035       end if;
2036
2037       Close (Dep_File);
2038
2039       --  If the original sources were not in the dependency file, then we
2040       --  need to recompile. It may mean that we are using a different source
2041       --  (different variant) for this object file.
2042
2043       if not Source_In_Dependencies then
2044          if Verbose_Mode then
2045             Write_Str  ("      -> source ");
2046             Write_Str  (Source_Path);
2047             Write_Line (" is not in the dependencies");
2048          end if;
2049
2050          return;
2051       end if;
2052
2053       --  If we are here, then everything is OK, and we don't need
2054       --  to recompile.
2055
2056       if Verbose_Mode then
2057          Write_Line ("      -> up to date");
2058       end if;
2059
2060       Need_To_Compile := False;
2061    end Check_Compilation_Needed;
2062
2063    ---------------------------
2064    -- Check_For_C_Plus_Plus --
2065    ---------------------------
2066
2067    procedure Check_For_C_Plus_Plus is
2068    begin
2069       C_Plus_Plus_Is_Used := False;
2070
2071       for Project in Project_Table.First ..
2072                      Project_Table.Last (Project_Tree.Projects)
2073       loop
2074          if
2075            Project_Tree.Projects.Table (Project).Languages
2076                                            (C_Plus_Plus_Language_Index)
2077          then
2078             C_Plus_Plus_Is_Used := True;
2079             exit;
2080          end if;
2081       end loop;
2082    end Check_For_C_Plus_Plus;
2083
2084    -------------
2085    -- Compile --
2086    -------------
2087
2088    procedure Compile
2089      (Source_Id    : Other_Source_Id;
2090       Data         : in Project_Data;
2091       Local_Errors : in out Boolean)
2092    is
2093       Source  : Other_Source :=
2094         Project_Tree.Other_Sources.Table (Source_Id);
2095       Success : Boolean;
2096       CPATH   : String_Access := null;
2097
2098    begin
2099       --  If the compiler is not known yet, get its path name
2100
2101       if Compiler_Names (Source.Language) = null then
2102          Get_Compiler (Source.Language);
2103       end if;
2104
2105       --  For non GCC compilers, get the dependency file, first calling the
2106       --  compiler with the switch -M.
2107
2108       if not Compiler_Is_Gcc (Source.Language) then
2109          Last_Argument := 0;
2110
2111          --  Add the source name, preceded by -M
2112
2113          Add_Argument (Dash_M, True);
2114          Add_Argument (Get_Name_String (Source.Path_Name), True);
2115
2116          --  Add the compiling switches for this source found in
2117          --  package Compiler of the project file, if they exist.
2118
2119          Add_Switches
2120            (Data, Compiler, Source.Language, Source.File_Name);
2121
2122          --  Add the compiling switches for the language specified
2123          --  on the command line, if any.
2124
2125          for
2126            J in 1 .. Comp_Opts.Last (Options (Source.Language))
2127          loop
2128             Add_Argument (Options (Source.Language).Table (J), True);
2129          end loop;
2130
2131          --  Finally, add imported directory switches for this project file
2132
2133          Add_Search_Directories (Data, Source.Language);
2134
2135          --  And invoke the compiler using GNAT.Expect
2136
2137          Display_Command
2138            (Compiler_Names (Source.Language).all,
2139             Compiler_Paths (Source.Language));
2140
2141          begin
2142             Non_Blocking_Spawn
2143               (FD,
2144                Compiler_Paths (Source.Language).all,
2145                Arguments (1 .. Last_Argument),
2146                Buffer_Size => 0,
2147                Err_To_Out => True);
2148
2149             declare
2150                Dep_File : Ada.Text_IO.File_Type;
2151                Result   : Expect_Match;
2152                Status   : Integer;
2153
2154             begin
2155                --  Create the dependency file
2156
2157                Create (Dep_File, Out_File, Get_Name_String (Source.Dep_Name));
2158
2159                loop
2160                   Expect (FD, Result, Line_Matcher);
2161
2162                   exit when Result = Expect_Timeout;
2163
2164                   declare
2165                      S : constant String := Strip_CR_LF (Expect_Out (FD));
2166
2167                   begin
2168                      --  Each line of the output is put in the dependency
2169                      --  file, including errors. If there are errors, the
2170                      --  syntax of the dependency file will be incorrect and
2171                      --  recompilation will occur automatically the next time
2172                      --  the dependencies are checked.
2173
2174                      Put_Line (Dep_File, S);
2175                   end;
2176                end loop;
2177
2178                --  If we are here, it means we had a timeout, so the
2179                --  dependency file may be incomplete. It is safer to
2180                --  delete it, otherwise the dependencies may be wrong.
2181
2182                Close (FD, Status);
2183                Close (Dep_File);
2184                Delete_File (Get_Name_String (Source.Dep_Name), Success);
2185
2186             exception
2187             when Process_Died =>
2188
2189                   --  This is the normal outcome. Just close the file
2190
2191                   Close (FD, Status);
2192                   Close (Dep_File);
2193
2194             when others =>
2195
2196                   --  Something wrong happened. It is safer to delete the
2197                   --  dependency file, otherwise the dependencies may be wrong.
2198
2199                   Close (FD, Status);
2200
2201                   if Is_Open (Dep_File) then
2202                      Close (Dep_File);
2203                   end if;
2204
2205                   Delete_File (Get_Name_String (Source.Dep_Name), Success);
2206             end;
2207
2208          exception
2209                --  If we cannot spawn the compiler, then the dependencies are
2210                --  not updated. It is safer then to delete the dependency file,
2211                --  otherwise the dependencies may be wrong.
2212
2213             when Invalid_Process =>
2214                Delete_File (Get_Name_String (Source.Dep_Name), Success);
2215          end;
2216       end if;
2217
2218       Last_Argument := 0;
2219
2220       --  For GCC compilers, make sure the language is always specified to
2221       --  to the GCC driver, in case the extension is not recognized by the
2222       --  GCC driver as a source of the language.
2223
2224       if Compiler_Is_Gcc (Source.Language) then
2225          Add_Argument (Dash_x, Verbose_Mode);
2226          Add_Argument
2227            (Get_Name_String (Language_Names.Table (Source.Language)),
2228             Verbose_Mode);
2229       end if;
2230
2231       Add_Argument (Dash_c, True);
2232
2233       --  Add the compiling switches for this source found in
2234       --  package Compiler of the project file, if they exist.
2235
2236       Add_Switches
2237         (Data, Compiler, Source.Language, Source.File_Name);
2238
2239       --  Specify the source to be compiled
2240
2241       Add_Argument (Get_Name_String (Source.Path_Name), True);
2242
2243       --  If non static library project, compile with the PIC option if there
2244       --  is one (when there is no PIC option, function MLib.Tgt.PIC_Option
2245       --  returns an empty string, and Add_Argument with an empty string has
2246       --  no effect).
2247
2248       if Data.Library and then Data.Library_Kind /= Static then
2249          Add_Argument (PIC_Option, True);
2250       end if;
2251
2252       --  Indicate the name of the object
2253
2254       Add_Argument (Dash_o, True);
2255       Add_Argument (Get_Name_String (Source.Object_Name), True);
2256
2257       --  When compiler is GCC, use the magic switch that creates
2258       --  the dependency file in the correct format.
2259
2260       if Compiler_Is_Gcc (Source.Language) then
2261          Add_Argument
2262            ("-Wp,-MD," & Get_Name_String (Source.Dep_Name),
2263             Verbose_Mode);
2264       end if;
2265
2266       --  Add the compiling switches for the language specified
2267       --  on the command line, if any.
2268
2269       for J in 1 .. Comp_Opts.Last (Options (Source.Language)) loop
2270          Add_Argument (Options (Source.Language).Table (J), True);
2271       end loop;
2272
2273       --  Finally, add the imported directory switches for this
2274       --  project file (or, for gcc compilers, set up the CPATH env var
2275       --  if needed).
2276
2277       Add_Search_Directories (Data, Source.Language);
2278
2279       --  Set CPATH, if compiler is GCC
2280
2281       if Compiler_Is_Gcc (Source.Language) then
2282          CPATH := Current_Include_Paths (Source.Language);
2283       end if;
2284
2285       --  And invoke the compiler
2286
2287       Display_Command
2288         (Name  => Compiler_Names (Source.Language).all,
2289          Path  => Compiler_Paths (Source.Language),
2290          CPATH => CPATH);
2291
2292       Spawn
2293         (Compiler_Paths (Source.Language).all,
2294          Arguments (1 .. Last_Argument),
2295          Success);
2296
2297       --  Case of successful compilation
2298
2299       if Success then
2300
2301          --  Update the time stamp of the object file
2302
2303          Source.Object_TS := File_Stamp (Source.Object_Name);
2304
2305          --  Do some sanity checks
2306
2307          if Source.Object_TS = Empty_Time_Stamp then
2308             Local_Errors := True;
2309             Report_Error
2310               ("object file ",
2311                Get_Name_String (Source.Object_Name),
2312                " has not been created");
2313
2314          elsif Source.Object_TS < Source.Source_TS then
2315             Local_Errors := True;
2316             Report_Error
2317               ("object file ",
2318                Get_Name_String (Source.Object_Name),
2319                " has not been modified");
2320
2321          else
2322             --  Everything looks fine, update the Other_Sources table
2323
2324             Project_Tree.Other_Sources.Table (Source_Id) := Source;
2325          end if;
2326
2327       --  Compilation failed
2328
2329       else
2330          Local_Errors := True;
2331          Report_Error
2332            ("compilation of ",
2333             Get_Name_String (Source.Path_Name),
2334             " failed");
2335       end if;
2336    end Compile;
2337
2338    --------------------------------
2339    -- Compile_Individual_Sources --
2340    --------------------------------
2341
2342    procedure Compile_Individual_Sources is
2343       Data         : Project_Data :=
2344                        Project_Tree.Projects.Table (Main_Project);
2345       Source_Id    : Other_Source_Id;
2346       Source       : Other_Source;
2347       Source_Name  : Name_Id;
2348       Project_Name : String := Get_Name_String (Data.Name);
2349       Dummy        : Boolean := False;
2350
2351       Ada_Is_A_Language : constant Boolean :=
2352                             Data.Languages (Ada_Language_Index);
2353
2354    begin
2355       Ada_Mains.Init;
2356       To_Mixed (Project_Name);
2357       Compile_Only := True;
2358
2359       Get_Imported_Directories (Main_Project, Data);
2360       Project_Tree.Projects.Table (Main_Project) := Data;
2361
2362       --  Compilation will occur in the object directory
2363
2364       Change_Dir (Get_Name_String (Data.Object_Directory));
2365
2366       if not Data.Other_Sources_Present then
2367          if Ada_Is_A_Language then
2368             Mains.Reset;
2369
2370             loop
2371                declare
2372                   Main : constant String := Mains.Next_Main;
2373                begin
2374                   exit when Main'Length = 0;
2375                   Ada_Mains.Increment_Last;
2376                   Ada_Mains.Table (Ada_Mains.Last) := new String'(Main);
2377                end;
2378             end loop;
2379
2380          else
2381             Osint.Fail
2382               ("project ", Project_Name, " contains no source");
2383          end if;
2384
2385       else
2386          Mains.Reset;
2387
2388          loop
2389             declare
2390                Main : constant String := Mains.Next_Main;
2391             begin
2392                Name_Len := Main'Length;
2393                exit when Name_Len = 0;
2394                Name_Buffer (1 .. Name_Len) := Main;
2395                Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2396                Source_Name := Name_Find;
2397
2398                if not Sources_Compiled.Get (Source_Name) then
2399                   Sources_Compiled.Set (Source_Name, True);
2400                   Source_Id := Data.First_Other_Source;
2401
2402                   while Source_Id /= No_Other_Source loop
2403                      Source :=
2404                        Project_Tree.Other_Sources.Table (Source_Id);
2405                      exit when Source.File_Name = Source_Name;
2406                      Source_Id := Source.Next;
2407                   end loop;
2408
2409                   if Source_Id = No_Other_Source then
2410                      if Ada_Is_A_Language then
2411                         Ada_Mains.Increment_Last;
2412                         Ada_Mains.Table (Ada_Mains.Last) := new String'(Main);
2413
2414                      else
2415                         Report_Error
2416                           (Main,
2417                            " is not a valid source of project ",
2418                            Project_Name);
2419                      end if;
2420
2421                   else
2422                      Compile (Source_Id, Data, Dummy);
2423                   end if;
2424                end if;
2425             end;
2426          end loop;
2427       end if;
2428
2429       if Ada_Mains.Last > 0 then
2430
2431          --  Invoke gnatmake for all Ada sources
2432
2433          Last_Argument := 0;
2434          Add_Argument (Dash_u, True);
2435
2436          for Index in 1 .. Ada_Mains.Last loop
2437             Add_Argument (Ada_Mains.Table (Index), True);
2438          end loop;
2439
2440          Compile_Link_With_Gnatmake (Mains_Specified => False);
2441       end if;
2442    end Compile_Individual_Sources;
2443
2444    --------------------------------
2445    -- Compile_Link_With_Gnatmake --
2446    --------------------------------
2447
2448    procedure Compile_Link_With_Gnatmake (Mains_Specified : Boolean) is
2449       Data    : constant Project_Data :=
2450                   Project_Tree.Projects.Table (Main_Project);
2451       Success : Boolean;
2452
2453    begin
2454       --  Array Arguments may already contain some arguments, so we don't
2455       --  set Last_Argument to 0.
2456
2457       --  Get the gnatmake to invoke
2458
2459       Get_Compiler (Ada_Language_Index);
2460
2461       --  Specify the project file
2462
2463       Add_Argument (Dash_P, True);
2464       Add_Argument (Get_Name_String (Data.Path_Name), True);
2465
2466       --  Add the -X switches, if any
2467
2468       for Index in 1 .. X_Switches.Last loop
2469          Add_Argument (X_Switches.Table (Index), True);
2470       end loop;
2471
2472       --  If Mains_Specified is True, find the mains in package Mains
2473
2474       if Mains_Specified then
2475          Mains.Reset;
2476
2477          loop
2478             declare
2479                Main : constant String := Mains.Next_Main;
2480             begin
2481                exit when Main'Length = 0;
2482                Add_Argument (Main, True);
2483             end;
2484          end loop;
2485       end if;
2486
2487       --  Specify output file name, if any was specified on the command line
2488
2489       if Output_File_Name /= null then
2490          Add_Argument (Dash_o, True);
2491          Add_Argument (Output_File_Name, True);
2492       end if;
2493
2494       --  Transmit some switches to gnatmake
2495
2496       --  -c
2497
2498       if Compile_Only then
2499          Add_Argument (Dash_c, True);
2500       end if;
2501
2502       --  -d
2503
2504       if Display_Compilation_Progress then
2505          Add_Argument (Dash_d, True);
2506       end if;
2507
2508       --  -k
2509
2510       if Keep_Going then
2511          Add_Argument (Dash_k, True);
2512       end if;
2513
2514       --  -f
2515
2516       if Force_Compilations then
2517          Add_Argument (Dash_f, True);
2518       end if;
2519
2520       --  -v
2521
2522       if Verbose_Mode then
2523          Add_Argument (Dash_v, True);
2524       end if;
2525
2526       --  -q
2527
2528       if Quiet_Output then
2529          Add_Argument (Dash_q, True);
2530       end if;
2531
2532       --  -vP1 and -vP2
2533
2534       case Current_Verbosity is
2535          when Default =>
2536             null;
2537
2538          when Medium =>
2539             Add_Argument (Dash_vP1, True);
2540
2541          when High =>
2542             Add_Argument (Dash_vP2, True);
2543       end case;
2544
2545       --  If there are compiling options for Ada, transmit them to gnatmake
2546
2547       if Comp_Opts.Last (Options (Ada_Language_Index)) /= 0 then
2548          Add_Argument (Dash_cargs, True);
2549
2550          for Arg in 1 .. Comp_Opts.Last (Options (Ada_Language_Index)) loop
2551             Add_Argument (Options (Ada_Language_Index).Table (Arg), True);
2552          end loop;
2553       end if;
2554
2555       if not Compile_Only then
2556
2557          --  Linking options
2558
2559          if Linker_Options.Last /= 0 then
2560             Add_Argument (Dash_largs, True);
2561          else
2562             Add_Argument (Dash_largs, Verbose_Mode);
2563          end if;
2564
2565          --  Add the archives
2566
2567          Add_Archives (For_Gnatmake => True);
2568
2569          --  If there are linking options from the command line,
2570          --  transmit them to gnatmake.
2571
2572          for Arg in 1 .. Linker_Options.Last loop
2573             Add_Argument (Linker_Options.Table (Arg), True);
2574          end loop;
2575       end if;
2576
2577       --  And invoke gnatmake
2578
2579       Display_Command
2580         (Compiler_Names (Ada_Language_Index).all,
2581          Compiler_Paths (Ada_Language_Index));
2582
2583       Spawn
2584         (Compiler_Paths (Ada_Language_Index).all,
2585          Arguments (1 .. Last_Argument),
2586          Success);
2587
2588       --  Report an error if call to gnatmake failed
2589
2590       if not Success then
2591          Report_Error
2592            ("invocation of ",
2593             Compiler_Names (Ada_Language_Index).all,
2594             " failed");
2595       end if;
2596
2597    end Compile_Link_With_Gnatmake;
2598
2599    ---------------------
2600    -- Compile_Sources --
2601    ---------------------
2602
2603    procedure Compile_Sources is
2604       Data         : Project_Data;
2605       Source_Id    : Other_Source_Id;
2606       Source       : Other_Source;
2607
2608       Local_Errors : Boolean := False;
2609       --  Set to True when there is a compilation error. Used only when
2610       --  Keep_Going is True, to inhibit the building of the archive.
2611
2612       Need_To_Compile : Boolean;
2613       --  Set to True when a source needs to be compiled/recompiled.
2614
2615       Need_To_Rebuild_Archive : Boolean := Force_Compilations;
2616       --  True when the archive needs to be built/rebuilt unconditionally
2617
2618       Total_Number_Of_Sources : Int := 0;
2619
2620       Current_Source_Number : Int := 0;
2621
2622    begin
2623       --  First, get the number of sources
2624
2625       for Project in Project_Table.First ..
2626                      Project_Table.Last (Project_Tree.Projects)
2627       loop
2628          Data := Project_Tree.Projects.Table (Project);
2629
2630          if (not Data.Virtual) and then Data.Other_Sources_Present then
2631             Source_Id := Data.First_Other_Source;
2632             while Source_Id /= No_Other_Source loop
2633                Source := Project_Tree.Other_Sources.Table (Source_Id);
2634                Total_Number_Of_Sources := Total_Number_Of_Sources + 1;
2635                Source_Id := Source.Next;
2636             end loop;
2637          end if;
2638       end loop;
2639
2640       --  Loop through project files
2641
2642       for Project in Project_Table.First ..
2643                      Project_Table.Last (Project_Tree.Projects)
2644       loop
2645          Local_Errors := False;
2646          Data := Project_Tree.Projects.Table (Project);
2647
2648          --  Nothing to do when no sources of language other than Ada
2649
2650          if (not Data.Virtual) and then Data.Other_Sources_Present then
2651
2652             --  If the imported directory switches are unknown, compute them
2653
2654             if not Data.Include_Data_Set then
2655                Get_Imported_Directories (Project, Data);
2656                Data.Include_Data_Set := True;
2657                Project_Tree.Projects.Table (Project) := Data;
2658             end if;
2659
2660             Need_To_Rebuild_Archive := Force_Compilations;
2661
2662             --  Compilation will occur in the object directory
2663
2664             Change_Dir (Get_Name_String (Data.Object_Directory));
2665
2666             Source_Id := Data.First_Other_Source;
2667
2668             --  Process each source one by one
2669
2670             while Source_Id /= No_Other_Source loop
2671
2672                Source := Project_Tree.Other_Sources.Table (Source_Id);
2673                Current_Source_Number := Current_Source_Number + 1;
2674                Need_To_Compile := Force_Compilations;
2675
2676                --  Check if compilation is needed
2677
2678                if not Need_To_Compile then
2679                   Check_Compilation_Needed (Source, Need_To_Compile);
2680                end if;
2681
2682                --  Proceed, if compilation is needed
2683
2684                if Need_To_Compile then
2685
2686                   --  If a source is compiled/recompiled, of course the
2687                   --  archive will need to be built/rebuilt.
2688
2689                   Need_To_Rebuild_Archive := True;
2690                   Compile (Source_Id, Data, Local_Errors);
2691                end if;
2692
2693                if Display_Compilation_Progress then
2694                   Write_Str ("completed ");
2695                   Write_Int (Current_Source_Number);
2696                   Write_Str (" out of ");
2697                   Write_Int (Total_Number_Of_Sources);
2698                   Write_Str (" (");
2699                   Write_Int
2700                     ((Current_Source_Number * 100) / Total_Number_Of_Sources);
2701                   Write_Str ("%)...");
2702                   Write_Eol;
2703                end if;
2704
2705                --  Next source, if any
2706
2707                Source_Id := Source.Next;
2708             end loop;
2709
2710             if Need_To_Rebuild_Archive and then (not Data.Library) then
2711                Need_To_Rebuild_Global_Archive := True;
2712             end if;
2713
2714             --  If there was no compilation error and -c was not used,
2715             --  build / rebuild the archive if necessary.
2716
2717             if not Local_Errors
2718               and then Data.Library
2719               and then not Data.Languages (Ada_Language_Index)
2720               and then not Compile_Only
2721             then
2722                Build_Library (Project, Need_To_Rebuild_Archive);
2723             end if;
2724          end if;
2725       end loop;
2726    end Compile_Sources;
2727
2728    ---------------
2729    -- Copyright --
2730    ---------------
2731
2732    procedure Copyright is
2733    begin
2734       --  Only output the Copyright notice once
2735
2736       if not Copyright_Output then
2737          Copyright_Output := True;
2738          Write_Eol;
2739          Write_Str ("GPRMAKE ");
2740          Write_Str (Gnatvsn.Gnat_Version_String);
2741          Write_Str (" Copyright 2004 Free Software Foundation, Inc.");
2742          Write_Eol;
2743       end if;
2744    end Copyright;
2745
2746    ------------------------------------
2747    -- Create_Archive_Dependency_File --
2748    ------------------------------------
2749
2750    procedure Create_Archive_Dependency_File
2751      (Name         : String;
2752       First_Source : Other_Source_Id)
2753    is
2754       Source_Id : Other_Source_Id := First_Source;
2755       Source    : Other_Source;
2756       Dep_File  : Ada.Text_IO.File_Type;
2757       use Ada.Text_IO;
2758
2759    begin
2760       --  Create the file in Append mode, to avoid automatic insertion of
2761       --  an end of line if file is empty.
2762
2763       Create (Dep_File, Append_File, Name);
2764
2765       while Source_Id /= No_Other_Source loop
2766          Source := Project_Tree.Other_Sources.Table (Source_Id);
2767          Put_Line (Dep_File, Get_Name_String (Source.Object_Name));
2768          Put_Line (Dep_File, String (Source.Object_TS));
2769          Source_Id := Source.Next;
2770       end loop;
2771
2772       Close (Dep_File);
2773
2774    exception
2775       when others =>
2776          if Is_Open (Dep_File) then
2777             Close (Dep_File);
2778          end if;
2779    end Create_Archive_Dependency_File;
2780
2781    -------------------------------------------
2782    -- Create_Global_Archive_Dependency_File --
2783    -------------------------------------------
2784
2785    procedure Create_Global_Archive_Dependency_File (Name : String) is
2786       Source_Id : Other_Source_Id;
2787       Source    : Other_Source;
2788       Dep_File  : Ada.Text_IO.File_Type;
2789
2790       use Ada.Text_IO;
2791
2792    begin
2793       --  Create the file in Append mode, to avoid automatic insertion of
2794       --  an end of line if file is empty.
2795
2796       Create (Dep_File, Append_File, Name);
2797
2798       --  Get all the object files of non-Ada sources in non-library projects
2799
2800       for Project in Project_Table.First ..
2801                      Project_Table.Last (Project_Tree.Projects)
2802       loop
2803          if not Project_Tree.Projects.Table (Project).Library then
2804             Source_Id :=
2805               Project_Tree.Projects.Table (Project).First_Other_Source;
2806
2807             while Source_Id /= No_Other_Source loop
2808                Source := Project_Tree.Other_Sources.Table (Source_Id);
2809
2810                --  Put only those object files that are in the global archive
2811
2812                if Is_Included_In_Global_Archive
2813                     (Source.Object_Name, Project)
2814                then
2815                   Put_Line (Dep_File, Get_Name_String (Source.Object_Path));
2816                   Put_Line (Dep_File, String (Source.Object_TS));
2817                end if;
2818
2819                Source_Id := Source.Next;
2820             end loop;
2821          end if;
2822       end loop;
2823
2824       Close (Dep_File);
2825
2826    exception
2827       when others =>
2828          if Is_Open (Dep_File) then
2829             Close (Dep_File);
2830          end if;
2831    end Create_Global_Archive_Dependency_File;
2832
2833    ---------------------
2834    -- Display_Command --
2835    ---------------------
2836
2837    procedure Display_Command
2838      (Name  : String;
2839       Path  : String_Access;
2840       CPATH : String_Access := null)
2841    is
2842    begin
2843       --  Only display the command in Verbose Mode (-v) or when
2844       --  not in Quiet Output (no -q).
2845
2846       if Verbose_Mode or (not Quiet_Output) then
2847
2848          --  In Verbose Mode output the full path of the spawned process
2849
2850          if Verbose_Mode then
2851             if CPATH /= null then
2852                Write_Str  ("CPATH = ");
2853                Write_Line (CPATH.all);
2854             end if;
2855
2856             Write_Str (Path.all);
2857
2858          else
2859             Write_Str (Name);
2860          end if;
2861
2862          --  Display only the arguments for which the display flag is set
2863          --  (in Verbose Mode, the display flag is set for all arguments)
2864
2865          for Arg in 1 .. Last_Argument loop
2866             if Arguments_Displayed (Arg) then
2867                Write_Char (' ');
2868                Write_Str (Arguments (Arg).all);
2869             end if;
2870          end loop;
2871
2872          Write_Eol;
2873       end if;
2874    end Display_Command;
2875
2876    ------------------
2877    -- Get_Compiler --
2878    ------------------
2879
2880    procedure Get_Compiler (For_Language : First_Language_Indexes) is
2881       Data : constant Project_Data :=
2882                Project_Tree.Projects.Table (Main_Project);
2883
2884       Ide : constant Package_Id :=
2885         Value_Of
2886           (Name_Ide,
2887            In_Packages => Data.Decl.Packages,
2888            In_Tree     => Project_Tree);
2889       --  The id of the package IDE in the project file
2890
2891       Compiler : constant Variable_Value :=
2892         Value_Of
2893           (Name                    => Language_Names.Table (For_Language),
2894            Index                   => 0,
2895            Attribute_Or_Array_Name => Name_Compiler_Command,
2896            In_Package              => Ide,
2897            In_Tree                 => Project_Tree);
2898       --  The value of Compiler_Command ("language") in package IDE, if defined
2899
2900    begin
2901       --  No need to do it again if the compiler is known for this language
2902
2903       if Compiler_Names (For_Language) = null then
2904
2905          --  If compiler command is not defined for this language in package
2906          --  IDE, use the default compiler for this language.
2907
2908          if Compiler = Nil_Variable_Value then
2909             if For_Language in Default_Compiler_Names'Range then
2910                Compiler_Names (For_Language) :=
2911                  Default_Compiler_Names (For_Language);
2912
2913             else
2914                Osint.Fail
2915                  ("unknow compiler name for language """,
2916                   Get_Name_String (Language_Names.Table (For_Language)),
2917                   """");
2918             end if;
2919
2920          else
2921             Compiler_Names (For_Language) :=
2922               new String'(Get_Name_String (Compiler.Value));
2923          end if;
2924
2925          --  Check we have a GCC compiler (name ends with "gcc" or "g++")
2926
2927          declare
2928             Comp_Name : constant String := Compiler_Names (For_Language).all;
2929             Last3     : String (1 .. 3);
2930          begin
2931             if Comp_Name'Length >= 3 then
2932                Last3 := Comp_Name (Comp_Name'Last - 2 .. Comp_Name'Last);
2933                Compiler_Is_Gcc (For_Language) :=
2934                  (Last3 = "gcc") or (Last3 = "g++");
2935             else
2936                Compiler_Is_Gcc (For_Language) := False;
2937             end if;
2938          end;
2939
2940          --  Locate the compiler on the path
2941
2942          Compiler_Paths (For_Language) :=
2943            Locate_Exec_On_Path (Compiler_Names (For_Language).all);
2944
2945          --  Fail if compiler cannot be found
2946
2947          if Compiler_Paths (For_Language) = null then
2948             if For_Language = Ada_Language_Index then
2949                Osint.Fail
2950                  ("unable to locate """,
2951                   Compiler_Names (For_Language).all,
2952                   """");
2953
2954             else
2955                Osint.Fail
2956                  ("unable to locate " &
2957                   Get_Name_String (Language_Names.Table (For_Language)),
2958                   " compiler """, Compiler_Names (For_Language).all & '"');
2959             end if;
2960          end if;
2961       end if;
2962    end Get_Compiler;
2963
2964    ------------------------------
2965    -- Get_Imported_Directories --
2966    ------------------------------
2967
2968    procedure Get_Imported_Directories
2969      (Project : Project_Id;
2970       Data    : in out Project_Data)
2971    is
2972       Imported_Projects : Project_List := Data.Imported_Projects;
2973
2974       Path_Length : Natural := 0;
2975       Position    : Natural := 0;
2976
2977       procedure Add (Source_Dirs : String_List_Id);
2978       --  Add a list of source directories
2979
2980       procedure Recursive_Get_Dirs (Prj : Project_Id);
2981       --  Recursive procedure to get the source directories of this project
2982       --  file and of the project files it imports, in the correct order.
2983
2984       ---------
2985       -- Add --
2986       ---------
2987
2988       procedure Add (Source_Dirs : String_List_Id) is
2989          Element_Id : String_List_Id := Source_Dirs;
2990          Element    : String_Element;
2991          Add_Arg    : Boolean := True;
2992
2993       begin
2994          --  Add each source directory path name, preceded by "-I" to Arguments
2995
2996          while Element_Id /= Nil_String loop
2997             Element := Project_Tree.String_Elements.Table (Element_Id);
2998
2999             if Element.Value /= No_Name then
3000                Get_Name_String (Element.Value);
3001
3002                if Name_Len > 0 then
3003                   --  Remove a trailing directory separator: this may cause
3004                   --  problems on Windows.
3005
3006                   if Name_Len > 1
3007                     and then Name_Buffer (Name_Len) = Directory_Separator
3008                   then
3009                      Name_Len := Name_Len - 1;
3010                   end if;
3011
3012                   declare
3013                      Arg : constant String :=
3014                              "-I" & Name_Buffer (1 .. Name_Len);
3015                   begin
3016                      --  Check if directory is already in the list.
3017                      --  If it is, no need to put it again.
3018
3019                      for Index in 1 .. Last_Argument loop
3020                         if Arguments (Index).all = Arg then
3021                            Add_Arg := False;
3022                            exit;
3023                         end if;
3024                      end loop;
3025
3026                      if Add_Arg then
3027                         if Path_Length /= 0 then
3028                            Path_Length := Path_Length + 1;
3029                         end if;
3030
3031                         Path_Length := Path_Length + Name_Len;
3032
3033                         Add_Argument (Arg, True);
3034                      end if;
3035                   end;
3036                end if;
3037             end if;
3038
3039             Element_Id := Element.Next;
3040          end loop;
3041       end Add;
3042
3043       ------------------------
3044       -- Recursive_Get_Dirs --
3045       ------------------------
3046
3047       procedure Recursive_Get_Dirs (Prj : Project_Id) is
3048          Data     : Project_Data;
3049          Imported : Project_List;
3050
3051       begin
3052          --  Nothing to do if project is undefined
3053
3054          if Prj /= No_Project then
3055             Data := Project_Tree.Projects.Table (Prj);
3056
3057             --  Nothing to do if project has already been processed
3058
3059             if not Data.Seen then
3060
3061                --  Mark the project as processed, to avoid multiple processing
3062                --  of the same project.
3063
3064                Project_Tree.Projects.Table (Prj).Seen := True;
3065
3066                --  Add the source directories of this project
3067
3068                if not Data.Virtual then
3069                   Add (Data.Source_Dirs);
3070                end if;
3071
3072                Recursive_Get_Dirs (Data.Extends);
3073
3074                Imported := Data.Imported_Projects;
3075
3076                --  Call itself for all imported projects, if any
3077
3078                while Imported /= Empty_Project_List loop
3079                   Recursive_Get_Dirs
3080                     (Project_Tree.Project_Lists.Table
3081                        (Imported).Project);
3082                   Imported :=
3083                     Project_Tree.Project_Lists.Table (Imported).Next;
3084                end loop;
3085             end if;
3086          end if;
3087       end Recursive_Get_Dirs;
3088
3089    --  Start of processing for Get_Imported_Directories
3090
3091    begin
3092       --  First, mark all project as not processed
3093
3094       for J in Project_Table.First ..
3095                Project_Table.Last (Project_Tree.Projects)
3096       loop
3097          Project_Tree.Projects.Table (J).Seen := False;
3098       end loop;
3099
3100       --  Empty Arguments
3101
3102       Last_Argument := 0;
3103
3104       --  Process this project individually, project data are already known
3105
3106       Project_Tree.Projects.Table (Project).Seen := True;
3107
3108       Add (Data.Source_Dirs);
3109
3110       Recursive_Get_Dirs (Data.Extends);
3111
3112       while Imported_Projects /= Empty_Project_List loop
3113          Recursive_Get_Dirs
3114            (Project_Tree.Project_Lists.Table
3115               (Imported_Projects).Project);
3116          Imported_Projects := Project_Tree.Project_Lists.Table
3117                                 (Imported_Projects).Next;
3118       end loop;
3119
3120       Data.Imported_Directories_Switches :=
3121         new Argument_List'(Arguments (1 .. Last_Argument));
3122
3123       --  Create the Include_Path, from the Arguments
3124
3125       Data.Include_Path := new String (1 .. Path_Length);
3126       Data.Include_Path (1 .. Arguments (1)'Length - 2) :=
3127         Arguments (1)(Arguments (1)'First + 2 .. Arguments (1)'Last);
3128       Position := Arguments (1)'Length - 2;
3129
3130       for Arg in 2 .. Last_Argument loop
3131          Position := Position + 1;
3132          Data.Include_Path (Position) := Path_Separator;
3133          Data.Include_Path
3134            (Position + 1 .. Position + Arguments (Arg)'Length - 2) :=
3135            Arguments (Arg)(Arguments (Arg)'First + 2 .. Arguments (Arg)'Last);
3136          Position := Position + Arguments (Arg)'Length - 2;
3137       end loop;
3138
3139       Last_Argument := 0;
3140    end Get_Imported_Directories;
3141
3142    -------------
3143    -- Gprmake --
3144    -------------
3145
3146    procedure Gprmake is
3147    begin
3148       Makegpr.Initialize;
3149
3150       if Verbose_Mode then
3151          Write_Eol;
3152          Write_Str ("Parsing Project File """);
3153          Write_Str (Project_File_Name.all);
3154          Write_Str (""".");
3155          Write_Eol;
3156       end if;
3157
3158       --  Parse and process project files for other languages (not for Ada)
3159
3160       Prj.Pars.Parse
3161         (Project           => Main_Project,
3162          In_Tree           => Project_Tree,
3163          Project_File_Name => Project_File_Name.all,
3164          Packages_To_Check => Packages_To_Check);
3165
3166       --  Fail if parsing/processing was unsuccessful
3167
3168       if Main_Project = No_Project then
3169          Osint.Fail ("""", Project_File_Name.all, """ processing failed");
3170       end if;
3171
3172       if Verbose_Mode then
3173          Write_Eol;
3174          Write_Str ("Parsing of Project File """);
3175          Write_Str (Project_File_Name.all);
3176          Write_Str (""" is finished.");
3177          Write_Eol;
3178       end if;
3179
3180       --  If -f was specified, we will certainly need to link (except when
3181       --  -u or -c were specified, of course).
3182
3183       Need_To_Relink := Force_Compilations;
3184
3185       if Unique_Compile then
3186          if Mains.Number_Of_Mains = 0 then
3187             Osint.Fail
3188               ("No source specified to compile in 'unique compile' mode");
3189          else
3190             Compile_Individual_Sources;
3191             Report_Total_Errors ("compilation");
3192          end if;
3193
3194       else
3195          declare
3196             Data : constant Prj.Project_Data :=
3197                      Project_Tree.Projects.Table (Main_Project);
3198          begin
3199             if Data.Library and then Mains.Number_Of_Mains /= 0 then
3200                Osint.Fail
3201                  ("Cannot specify mains on the command line " &
3202                   "for a Library Project");
3203             end if;
3204
3205             --  First check for C++, to link libraries with g++,
3206             --  rather than gcc.
3207
3208             Check_For_C_Plus_Plus;
3209
3210             --  Compile sources and build archives for library project,
3211             --  if necessary.
3212
3213             Compile_Sources;
3214
3215             --  When Keep_Going is True, if we had some errors, fail now,
3216             --  reporting the number of compilation errors.
3217             --  Do not attempt to link.
3218
3219             Report_Total_Errors ("compilation");
3220
3221             --  If -c was not specified, link the executables,
3222             --  if there are any.
3223
3224             if not Compile_Only and then not Data.Library then
3225                Build_Global_Archive;
3226                Link_Executables;
3227             end if;
3228
3229             --  When Keep_Going is True, if we had some errors, fail, reporting
3230             --  the number of linking errors.
3231
3232             Report_Total_Errors ("linking");
3233          end;
3234       end if;
3235    end Gprmake;
3236
3237    ----------------
3238    -- Initialize --
3239    ----------------
3240
3241    procedure Initialize is
3242    begin
3243       --  Do some necessary package initializations
3244
3245       Csets.Initialize;
3246       Namet.Initialize;
3247       Snames.Initialize;
3248       Prj.Initialize (Project_Tree);
3249       Mains.Delete;
3250
3251       --  Set Name_Ide and Name_Compiler_Command
3252
3253       Name_Len := 0;
3254       Add_Str_To_Name_Buffer ("ide");
3255       Name_Ide := Name_Find;
3256
3257       Name_Len := 0;
3258       Add_Str_To_Name_Buffer ("compiler_command");
3259       Name_Compiler_Command := Name_Find;
3260
3261       --  Make sure the -X switch table is empty
3262
3263       X_Switches.Set_Last (0);
3264
3265       --  Get the command line arguments
3266
3267       Scan_Args : for Next_Arg in 1 .. Argument_Count loop
3268          Scan_Arg (Argument (Next_Arg));
3269       end loop Scan_Args;
3270
3271       --  Fail if command line ended with "-P"
3272
3273       if Project_File_Name_Expected then
3274          Osint.Fail ("project file name missing after -P");
3275
3276       --  Or if it ended with "-o"
3277
3278       elsif Output_File_Name_Expected then
3279          Osint.Fail ("output file name missing after -o");
3280       end if;
3281
3282       --  If no project file was specified, display the usage and fail
3283
3284       if Project_File_Name = null then
3285          Usage;
3286          Exit_Program (E_Success);
3287       end if;
3288
3289       --  To be able of finding libgnat.a in MLib.Tgt, we need to have the
3290       --  default search dirs established in Osint.
3291
3292       Osint.Add_Default_Search_Dirs;
3293    end Initialize;
3294
3295    -----------------------------------
3296    -- Is_Included_In_Global_Archive --
3297    -----------------------------------
3298
3299    function Is_Included_In_Global_Archive
3300      (Object_Name : Name_Id;
3301       Project     : Project_Id) return Boolean
3302    is
3303       Data   : Project_Data := Project_Tree.Projects.Table (Project);
3304       Source : Other_Source_Id;
3305
3306    begin
3307       while Data.Extended_By /= No_Project loop
3308          Data := Project_Tree.Projects.Table (Data.Extended_By);
3309
3310          Source := Data.First_Other_Source;
3311          while Source /= No_Other_Source loop
3312             if Project_Tree.Other_Sources.Table (Source).Object_Name =
3313                  Object_Name
3314             then
3315                return False;
3316             else
3317                Source :=
3318                  Project_Tree.Other_Sources.Table (Source).Next;
3319             end if;
3320          end loop;
3321       end loop;
3322
3323       return True;
3324    end Is_Included_In_Global_Archive;
3325
3326    ----------------------
3327    -- Link_Executables --
3328    ----------------------
3329
3330    procedure Link_Executables is
3331       Data : constant Project_Data :=
3332                Project_Tree.Projects.Table (Main_Project);
3333
3334       Mains_Specified : constant Boolean := Mains.Number_Of_Mains /= 0;
3335       --  True if main sources were specified on the command line
3336
3337       Object_Dir : constant String := Get_Name_String (Data.Object_Directory);
3338       --  Path of the object directory of the main project
3339
3340       Source_Id : Other_Source_Id;
3341       Source    : Other_Source;
3342       Success   : Boolean;
3343
3344       Linker_Name : String_Access;
3345       Linker_Path : String_Access;
3346       --  The linker name and path, when linking is not done by gnatlink
3347
3348       Link_Done   : Boolean := False;
3349       --  Set to True when the linker is invoked directly (not through
3350       --  gnatmake) to be able to report if mains were up to date at the end
3351       --  of execution.
3352
3353       procedure Add_C_Plus_Plus_Link_For_Gnatmake;
3354       --  Add the --LINK= switch for gnatlink, depending on the C++ compiler
3355
3356       procedure Check_Time_Stamps (Exec_Time_Stamp : Time_Stamp_Type);
3357       --  Check if there is an archive that is more recent than the executable
3358       --  to decide if we need to relink.
3359
3360       procedure Choose_C_Plus_Plus_Link_Process;
3361       --  If the C++ compiler is not g++, create the correct script to link
3362
3363       procedure Link_Foreign
3364         (Main    : String;
3365          Main_Id : Name_Id;
3366          Source  : Other_Source);
3367       --  Link a non-Ada main, when there is no Ada code
3368
3369       ---------------------------------------
3370       -- Add_C_Plus_Plus_Link_For_Gnatmake --
3371       ---------------------------------------
3372
3373       procedure Add_C_Plus_Plus_Link_For_Gnatmake is
3374       begin
3375          Add_Argument
3376            ("--LINK=" & Compiler_Names (C_Plus_Plus_Language_Index).all,
3377             Verbose_Mode);
3378       end Add_C_Plus_Plus_Link_For_Gnatmake;
3379
3380       -----------------------
3381       -- Check_Time_Stamps --
3382       -----------------------
3383
3384       procedure Check_Time_Stamps (Exec_Time_Stamp : Time_Stamp_Type) is
3385          Prj_Data : Project_Data;
3386
3387       begin
3388          for Prj in Project_Table.First ..
3389                     Project_Table.Last (Project_Tree.Projects)
3390          loop
3391             Prj_Data := Project_Tree.Projects.Table (Prj);
3392
3393             --  There is an archive only in project
3394             --  files with sources other than Ada
3395             --  sources.
3396
3397             if Data.Other_Sources_Present then
3398                declare
3399                   Archive_Path : constant String :=
3400                                    Get_Name_String
3401                                      (Prj_Data.Object_Directory) &
3402                   Directory_Separator &
3403                   "lib" &
3404                   Get_Name_String (Prj_Data.Name) &
3405                     '.' & Archive_Ext;
3406                   Archive_TS   : Time_Stamp_Type;
3407                begin
3408                   Name_Len := 0;
3409                   Add_Str_To_Name_Buffer
3410                     (Archive_Path);
3411                   Archive_TS := File_Stamp (Name_Find);
3412
3413                   --  If the archive is later than the
3414                   --  executable, we need to relink.
3415
3416                   if Archive_TS /=  Empty_Time_Stamp
3417                     and then
3418                       Exec_Time_Stamp < Archive_TS
3419                   then
3420                      Need_To_Relink := True;
3421
3422                      if Verbose_Mode then
3423                         Write_Str ("      -> ");
3424                         Write_Str (Archive_Path);
3425                         Write_Str (" has time stamp ");
3426                         Write_Str ("later than ");
3427                         Write_Line ("executable");
3428                      end if;
3429
3430                      exit;
3431                   end if;
3432                end;
3433             end if;
3434          end loop;
3435       end Check_Time_Stamps;
3436
3437       -------------------------------------
3438       -- Choose_C_Plus_Plus_Link_Process --
3439       -------------------------------------
3440
3441       procedure Choose_C_Plus_Plus_Link_Process is
3442       begin
3443          if Compiler_Names (C_Plus_Plus_Language_Index) = null then
3444             Get_Compiler (C_Plus_Plus_Language_Index);
3445          end if;
3446       end Choose_C_Plus_Plus_Link_Process;
3447
3448       ------------------
3449       -- Link_Foreign --
3450       ------------------
3451
3452       procedure Link_Foreign
3453         (Main    : String;
3454          Main_Id : Name_Id;
3455          Source  : Other_Source)
3456       is
3457          Executable_Name : constant String :=
3458                              Get_Name_String
3459                                (Executable_Of
3460                                     (Project  => Main_Project,
3461                                      In_Tree  => Project_Tree,
3462                                      Main     => Main_Id,
3463                                      Index    => 0,
3464                                      Ada_Main => False));
3465          --  File name of the executable
3466
3467          Executable_Path : constant String :=
3468                              Get_Name_String
3469                                (Data.Exec_Directory) &
3470                                 Directory_Separator &
3471                                 Executable_Name;
3472          --  Path name of the executable
3473
3474          Exec_Time_Stamp : Time_Stamp_Type;
3475
3476       begin
3477          --  Now, check if the executable is up to date. It is considered
3478          --  up to date if its time stamp is not earlier that the time stamp
3479          --  of any archive. Only do that if we don't know if we need to link.
3480
3481          if not Need_To_Relink then
3482
3483             --  Get the time stamp of the executable
3484
3485             Name_Len := 0;
3486             Add_Str_To_Name_Buffer (Executable_Path);
3487             Exec_Time_Stamp := File_Stamp (Name_Find);
3488
3489             if Verbose_Mode then
3490                Write_Str  ("   Checking executable ");
3491                Write_Line (Executable_Name);
3492             end if;
3493
3494             --  If executable does not exist, we need to link
3495
3496             if Exec_Time_Stamp = Empty_Time_Stamp then
3497                Need_To_Relink := True;
3498
3499                if Verbose_Mode then
3500                   Write_Line ("      -> not found");
3501                end if;
3502
3503             --  Otherwise, get the time stamps of each archive. If one of
3504             --  them is found later than the executable, we need to relink.
3505
3506             else
3507                Check_Time_Stamps (Exec_Time_Stamp);
3508             end if;
3509
3510             --  If Need_To_Relink is False, we are done
3511
3512             if Verbose_Mode and (not Need_To_Relink) then
3513                Write_Line ("      -> up to date");
3514             end if;
3515          end if;
3516
3517          --  Prepare to link
3518
3519          if Need_To_Relink then
3520             Link_Done := True;
3521
3522             Last_Argument := 0;
3523
3524             --  Specify the executable path name
3525
3526             Add_Argument (Dash_o, True);
3527             Add_Argument
3528               (Get_Name_String (Data.Exec_Directory) &
3529                Directory_Separator &
3530                Get_Name_String
3531                  (Executable_Of
3532                     (Project  => Main_Project,
3533                      In_Tree  => Project_Tree,
3534                      Main     => Main_Id,
3535                      Index    => 0,
3536                      Ada_Main => False)),
3537                True);
3538
3539             --  Specify the object file of the main source
3540
3541             Add_Argument
3542               (Object_Dir & Directory_Separator &
3543                Get_Name_String (Source.Object_Name),
3544                True);
3545
3546             --  Add all the archives, in a correct order
3547
3548             Add_Archives (For_Gnatmake => False);
3549
3550             --  Add the switches specified in package Linker of
3551             --  the main project.
3552
3553             Add_Switches
3554               (Data      => Data,
3555                Proc      => Linker,
3556                Language  => Source.Language,
3557                File_Name => Main_Id);
3558
3559             --  Add the switches specified in attribute
3560             --  Linker_Options of packages Linker.
3561
3562             if Link_Options_Switches = null then
3563                Link_Options_Switches :=
3564                  new Argument_List'
3565                    (Linker_Options_Switches (Main_Project, Project_Tree));
3566             end if;
3567
3568             Add_Arguments (Link_Options_Switches.all, True);
3569
3570             --  Add the linking options specified on the
3571             --  command line.
3572
3573             for Arg in 1 ..  Linker_Options.Last loop
3574                Add_Argument (Linker_Options.Table (Arg), True);
3575             end loop;
3576
3577             --  If there are shared libraries and the run path
3578             --  option is supported, add the run path switch.
3579
3580             if Lib_Path.Last > 0 then
3581                Add_Argument
3582                  (Path_Option.all &
3583                   String (Lib_Path.Table (1 .. Lib_Path.Last)),
3584                   Verbose_Mode);
3585             end if;
3586
3587             --  And invoke the linker
3588
3589             Display_Command (Linker_Name.all, Linker_Path);
3590             Spawn
3591               (Linker_Path.all,
3592                Arguments (1 .. Last_Argument),
3593                Success);
3594
3595             if not Success then
3596                Report_Error ("could not link ", Main);
3597             end if;
3598          end if;
3599       end Link_Foreign;
3600
3601    --  Start of processing of Link_Executables
3602
3603    begin
3604       --  If no mains specified, get mains from attribute Main, if it exists
3605
3606       if not Mains_Specified then
3607          declare
3608             Element_Id : String_List_Id := Data.Mains;
3609             Element    : String_Element;
3610
3611          begin
3612             while Element_Id /= Nil_String loop
3613                Element := Project_Tree.String_Elements.Table
3614                             (Element_Id);
3615
3616                if Element.Value /= No_Name then
3617                   Mains.Add_Main (Get_Name_String (Element.Value));
3618                end if;
3619
3620                Element_Id := Element.Next;
3621             end loop;
3622          end;
3623       end if;
3624
3625       if Mains.Number_Of_Mains = 0 then
3626
3627          --  If the attribute Main is an empty list or not specified,
3628          --  there is nothing to do.
3629
3630          if Verbose_Mode then
3631             Write_Line ("No main to link");
3632          end if;
3633          return;
3634       end if;
3635
3636       --  Check if -o was used for several mains
3637
3638       if Output_File_Name /= null and then Mains.Number_Of_Mains > 1 then
3639          Osint.Fail ("cannot specify an executable name for several mains");
3640       end if;
3641
3642       --  Check how we are going to do the link
3643
3644       if not Data.Other_Sources_Present then
3645
3646          --  Only Ada sources in the main project, and even maybe not
3647
3648          if not Data.Languages (Ada_Language_Index) then
3649
3650             --  Fail if the main project has no source of any language
3651
3652             Osint.Fail
3653               ("project """,
3654                Get_Name_String (Data.Name),
3655                """ has no sources, so no main can be linked");
3656
3657          else
3658             --  Only Ada sources in the main project, call gnatmake directly
3659
3660             Last_Argument := 0;
3661
3662             --  Choose correct linker if there is C++ code in other projects
3663
3664             if C_Plus_Plus_Is_Used then
3665                Choose_C_Plus_Plus_Link_Process;
3666                Add_Argument (Dash_largs, Verbose_Mode);
3667                Add_C_Plus_Plus_Link_For_Gnatmake;
3668                Add_Argument (Dash_margs, Verbose_Mode);
3669             end if;
3670
3671             Compile_Link_With_Gnatmake (Mains_Specified);
3672          end if;
3673
3674       else
3675          --  There are other language sources. First check if there are also
3676          --  sources in Ada.
3677
3678          if Data.Languages (Ada_Language_Index) then
3679
3680             --  There is a mix of Ada and other language sources in the main
3681             --  project. Any main that is not a source of the other languages
3682             --  will be deemed to be an Ada main.
3683
3684             --  Find the mains of the other languages and the Ada mains.
3685
3686             Mains.Reset;
3687             Ada_Mains.Set_Last (0);
3688             Other_Mains.Set_Last (0);
3689
3690             --  For each main
3691
3692             loop
3693                declare
3694                   Main    : constant String := Mains.Next_Main;
3695                   Main_Id : Name_Id;
3696
3697                begin
3698                   exit when Main'Length = 0;
3699
3700                   --  Get the main file name
3701
3702                   Name_Len := 0;
3703                   Add_Str_To_Name_Buffer (Main);
3704                   Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3705                   Main_Id := Name_Find;
3706                   Source_Id := Data.First_Other_Source;
3707
3708                   --  Check if it is a source of a language other than Ada
3709
3710                   while Source_Id /= No_Other_Source loop
3711                      Source :=
3712                        Project_Tree.Other_Sources.Table (Source_Id);
3713                      exit when Source.File_Name = Main_Id;
3714                      Source_Id := Source.Next;
3715                   end loop;
3716
3717                   --  If it is not, put it in the list of Ada mains
3718
3719                   if Source_Id = No_Other_Source then
3720                      Ada_Mains.Increment_Last;
3721                      Ada_Mains.Table (Ada_Mains.Last) := new String'(Main);
3722
3723                   --  Otherwise, put it in the list of other mains
3724
3725                   else
3726                      Other_Mains.Increment_Last;
3727                      Other_Mains.Table (Other_Mains.Last) := Source;
3728                   end if;
3729                end;
3730             end loop;
3731
3732             --  If C++ is one of the other language, create the shell script
3733             --  to do the link.
3734
3735             if C_Plus_Plus_Is_Used then
3736                Choose_C_Plus_Plus_Link_Process;
3737             end if;
3738
3739             --  Call gnatmake with the necessary switches for each non-Ada
3740             --  main, if there are some.
3741
3742             for Main in 1 .. Other_Mains.Last loop
3743                declare
3744                   Source : constant Other_Source := Other_Mains.Table (Main);
3745
3746                begin
3747                   Last_Argument := 0;
3748
3749                   --  Add -o if -o was specified
3750
3751                   if Output_File_Name = null then
3752                      Add_Argument (Dash_o, True);
3753                      Add_Argument
3754                        (Get_Name_String
3755                           (Executable_Of
3756                              (Project  => Main_Project,
3757                               In_Tree  => Project_Tree,
3758                               Main     => Other_Mains.Table (Main).File_Name,
3759                               Index    => 0,
3760                               Ada_Main => False)),
3761                         True);
3762                   end if;
3763
3764                   --  Call gnatmake with the -B switch
3765
3766                   Add_Argument (Dash_B, True);
3767
3768                   --  Add to the linking options the object file of the source
3769
3770                   Add_Argument (Dash_largs, Verbose_Mode);
3771                   Add_Argument
3772                     (Get_Name_String (Source.Object_Name), Verbose_Mode);
3773
3774                   --  If C++ is one of the language, add the --LINK switch
3775                   --  to the linking switches.
3776
3777                   if C_Plus_Plus_Is_Used then
3778                      Add_C_Plus_Plus_Link_For_Gnatmake;
3779                   end if;
3780
3781                   --  Add -margs so that the following switches are for
3782                   --  gnatmake
3783
3784                   Add_Argument (Dash_margs, Verbose_Mode);
3785
3786                   --  And link with gnatmake
3787
3788                   Compile_Link_With_Gnatmake (Mains_Specified => False);
3789                end;
3790             end loop;
3791
3792             --  If there are also Ada mains, call gnatmake for all these mains
3793
3794             if Ada_Mains.Last /= 0 then
3795                Last_Argument := 0;
3796
3797                --  Put all the Ada mains as the first arguments
3798
3799                for Main in 1 .. Ada_Mains.Last loop
3800                   Add_Argument (Ada_Mains.Table (Main).all, True);
3801                end loop;
3802
3803                --  If C++ is one of the languages, add the --LINK switch to
3804                --  the linking switches.
3805
3806                if Data.Languages (C_Plus_Plus_Language_Index) then
3807                   Add_Argument (Dash_largs, Verbose_Mode);
3808                   Add_C_Plus_Plus_Link_For_Gnatmake;
3809                   Add_Argument (Dash_margs, Verbose_Mode);
3810                end if;
3811
3812                --  And link with gnatmake
3813
3814                Compile_Link_With_Gnatmake (Mains_Specified => False);
3815             end if;
3816
3817          else
3818             --  No Ada source in main project
3819
3820             --  First, get the linker to invoke
3821
3822             if Data.Languages (C_Plus_Plus_Language_Index) then
3823                Get_Compiler (C_Plus_Plus_Language_Index);
3824                Linker_Name := Compiler_Names (C_Plus_Plus_Language_Index);
3825                Linker_Path := Compiler_Paths (C_Plus_Plus_Language_Index);
3826
3827             else
3828                Get_Compiler (C_Language_Index);
3829                Linker_Name := Compiler_Names (C_Language_Index);
3830                Linker_Path := Compiler_Paths (C_Language_Index);
3831             end if;
3832
3833             Link_Done := False;
3834
3835             Mains.Reset;
3836
3837             --  Get each main, check if it is a source of the main project,
3838             --  and if it is, invoke the linker.
3839
3840             loop
3841                declare
3842                   Main : constant String := Mains.Next_Main;
3843                   Main_Id : Name_Id;
3844                begin
3845                   exit when Main'Length = 0;
3846
3847                   --  Get the file name of the main
3848
3849                   Name_Len := 0;
3850                   Add_Str_To_Name_Buffer (Main);
3851                   Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3852                   Main_Id := Name_Find;
3853                   Source_Id := Data.First_Other_Source;
3854
3855                   --  Check if it is a source of the main project file
3856
3857                   while Source_Id /= No_Other_Source loop
3858                      Source :=
3859                        Project_Tree.Other_Sources.Table (Source_Id);
3860                      exit when Source.File_Name = Main_Id;
3861                      Source_Id := Source.Next;
3862                   end loop;
3863
3864                   --  Report an error if it is not
3865
3866                   if Source_Id = No_Other_Source then
3867                      Report_Error
3868                        (Main, "is not a source of project ",
3869                         Get_Name_String (Data.Name));
3870
3871                   else
3872                      Link_Foreign (Main, Main_Id, Source);
3873                   end if;
3874                end;
3875             end loop;
3876
3877             --  If no linking was done, report it, except in Quiet Output
3878
3879             if (Verbose_Mode or (not Quiet_Output)) and (not Link_Done) then
3880                Osint.Write_Program_Name;
3881
3882                if Mains.Number_Of_Mains = 1 then
3883
3884                   --  If there is only one executable, report its name too
3885
3886                   Write_Str (": """);
3887                   Mains.Reset;
3888
3889                   declare
3890                      Main    : constant String := Mains.Next_Main;
3891                      Main_Id : Name_Id;
3892                   begin
3893                      Name_Len := 0;
3894                      Add_Str_To_Name_Buffer (Main);
3895                      Main_Id := Name_Find;
3896                      Write_Str
3897                        (Get_Name_String
3898                           (Executable_Of
3899                              (Project  => Main_Project,
3900                               In_Tree  => Project_Tree,
3901                               Main     => Main_Id,
3902                               Index    => 0,
3903                               Ada_Main => False)));
3904                      Write_Line (""" up to date");
3905                   end;
3906
3907                else
3908                   Write_Line (": all executables up to date");
3909                end if;
3910             end if;
3911          end if;
3912       end if;
3913    end Link_Executables;
3914
3915    ------------------
3916    -- Report_Error --
3917    ------------------
3918
3919    procedure Report_Error
3920      (S1 : String;
3921       S2 : String := "";
3922       S3 : String := "")
3923    is
3924    begin
3925       --  If Keep_Going is True, output error message preceded by error header
3926
3927       if Keep_Going then
3928          Total_Number_Of_Errors := Total_Number_Of_Errors + 1;
3929          Write_Str (Error_Header);
3930          Write_Str (S1);
3931          Write_Str (S2);
3932          Write_Str (S3);
3933          Write_Eol;
3934
3935       --  Otherwise just fail
3936
3937       else
3938          Osint.Fail (S1, S2, S3);
3939       end if;
3940    end Report_Error;
3941
3942    -------------------------
3943    -- Report_Total_Errors --
3944    -------------------------
3945
3946    procedure Report_Total_Errors (Kind : String) is
3947    begin
3948       if Total_Number_Of_Errors /= 0 then
3949          if Total_Number_Of_Errors = 1 then
3950             Osint.Fail
3951               ("One ", Kind, " error");
3952
3953          else
3954             Osint.Fail
3955               ("Total of" & Total_Number_Of_Errors'Img,
3956                ' ' & Kind & " errors");
3957          end if;
3958       end if;
3959    end Report_Total_Errors;
3960
3961    --------------
3962    -- Scan_Arg --
3963    --------------
3964
3965    procedure Scan_Arg (Arg : String) is
3966    begin
3967       pragma Assert (Arg'First = 1);
3968
3969       if Arg'Length = 0 then
3970          return;
3971       end if;
3972
3973       --  If preceding switch was -P, a project file name need to be
3974       --  specified, not a switch.
3975
3976       if Project_File_Name_Expected then
3977          if Arg (1) = '-' then
3978             Osint.Fail ("project file name missing after -P");
3979          else
3980             Project_File_Name_Expected := False;
3981             Project_File_Name := new String'(Arg);
3982          end if;
3983
3984       --  If preceding switch was -o, an executable name need to be
3985       --  specified, not a switch.
3986
3987       elsif Output_File_Name_Expected then
3988          if Arg (1) = '-' then
3989             Osint.Fail ("output file name missing after -o");
3990          else
3991             Output_File_Name_Expected := False;
3992             Output_File_Name := new String'(Arg);
3993          end if;
3994
3995       --  Set the processor/language for the following switches
3996
3997       --  -cargs: Ada compiler arguments
3998
3999       elsif Arg = "-cargs" then
4000          Current_Language  := Ada_Language_Index;
4001          Current_Processor := Compiler;
4002
4003       elsif Arg'Length > 7 and then Arg (1 .. 7) = "-cargs:" then
4004          Name_Len := 0;
4005          Add_Str_To_Name_Buffer (Arg (8 .. Arg'Last));
4006          To_Lower (Name_Buffer (1 .. Name_Len));
4007
4008          declare
4009             Lang : constant Name_Id := Name_Find;
4010          begin
4011             Current_Language := Language_Indexes.Get (Lang);
4012
4013             if Current_Language = No_Language_Index then
4014                Add_Language_Name (Lang);
4015                Current_Language := Last_Language_Index;
4016             end if;
4017
4018             Current_Processor := Compiler;
4019          end;
4020
4021       elsif Arg = "-largs" then
4022          Current_Processor := Linker;
4023
4024       --  -gargs: gprmake
4025
4026       elsif Arg = "-gargs" then
4027          Current_Processor := None;
4028
4029       --  A special test is needed for the -o switch within a -largs since
4030       --  that is another way to specify the name of the final executable.
4031
4032       elsif Current_Processor = Linker and then Arg = "-o" then
4033          Osint.Fail
4034            ("switch -o not allowed within a -largs. Use -o directly.");
4035
4036       --  If current processor is not gprmake directly, store the option in
4037       --  the appropriate table.
4038
4039       elsif Current_Processor /= None then
4040          Add_Option (Arg);
4041
4042       --  Switches start with '-'
4043
4044       elsif Arg (1) = '-' then
4045          if Arg = "-c" then
4046             Compile_Only := True;
4047
4048             --  Make sure that when a main is specified and switch -c is used,
4049             --  only the main(s) is/are compiled.
4050
4051             if Mains.Number_Of_Mains > 0 then
4052                Unique_Compile := True;
4053             end if;
4054
4055          elsif Arg = "-d" then
4056             Display_Compilation_Progress := True;
4057
4058          elsif Arg = "-f" then
4059             Force_Compilations := True;
4060
4061          elsif Arg = "-h" then
4062             Usage;
4063
4064          elsif Arg = "-k" then
4065             Keep_Going := True;
4066
4067          elsif Arg = "-o" then
4068             if Output_File_Name /= null then
4069                Osint.Fail ("cannot specify several -o switches");
4070
4071             else
4072                Output_File_Name_Expected := True;
4073             end if;
4074
4075          elsif Arg'Length >= 2 and then Arg (2) = 'P' then
4076             if Project_File_Name /= null then
4077                Osint.Fail ("cannot have several project files specified");
4078
4079             elsif Arg'Length = 2 then
4080                Project_File_Name_Expected := True;
4081
4082             else
4083                Project_File_Name := new String'(Arg (3 .. Arg'Last));
4084             end if;
4085
4086          elsif Arg = "-q" then
4087             Quiet_Output := True;
4088
4089          elsif Arg = "-u" then
4090             Unique_Compile := True;
4091             Compile_Only   := True;
4092
4093          elsif Arg = "-v" then
4094             Verbose_Mode := True;
4095             Copyright;
4096
4097          elsif Arg'Length = 4 and then Arg (1 .. 3) = "-vP"
4098            and then Arg (4) in '0' .. '2'
4099          then
4100             case Arg (4) is
4101                when '0' =>
4102                   Current_Verbosity := Prj.Default;
4103                when '1' =>
4104                   Current_Verbosity := Prj.Medium;
4105                when '2' =>
4106                   Current_Verbosity := Prj.High;
4107                when others =>
4108                   null;
4109             end case;
4110
4111          elsif Arg'Length >= 3 and then Arg (2) = 'X'
4112            and then Is_External_Assignment (Arg)
4113          then
4114             --  Is_External_Assignment has side effects when it returns True
4115
4116             --  Record the -X switch, so that they can be passed to gnatmake,
4117             --  if gnatmake is called.
4118
4119             X_Switches.Increment_Last;
4120             X_Switches.Table (X_Switches.Last) := new String'(Arg);
4121
4122          else
4123             Osint.Fail ("illegal option """, Arg, """");
4124          end if;
4125
4126       else
4127          --  Not a switch: must be a main
4128
4129          Mains.Add_Main (Arg);
4130
4131          --  Make sure that when a main is specified and switch -c is used,
4132          --  only the main(s) is/are compiled.
4133
4134          if Compile_Only then
4135             Unique_Compile := True;
4136          end if;
4137       end if;
4138    end Scan_Arg;
4139
4140    -----------------
4141    -- Strip_CR_LF --
4142    -----------------
4143
4144    function Strip_CR_LF (Text : String) return String is
4145       To       : String (1 .. Text'Length);
4146       Index_To : Natural := 0;
4147
4148    begin
4149       for Index in Text'Range loop
4150          if (Text (Index) /= ASCII.CR) and then (Text (Index) /= ASCII.LF) then
4151             Index_To := Index_To + 1;
4152             To (Index_To) := Text (Index);
4153          end if;
4154       end loop;
4155
4156       return To (1 .. Index_To);
4157    end Strip_CR_LF;
4158
4159    -----------
4160    -- Usage --
4161    -----------
4162
4163    procedure Usage is
4164    begin
4165       if not Usage_Output then
4166          Usage_Output := True;
4167          Copyright;
4168
4169          Write_Str ("Usage: ");
4170          Osint.Write_Program_Name;
4171          Write_Str (" -P<project file> [opts]  [name] {");
4172
4173          for Lang in First_Language_Indexes loop
4174             Write_Str ("[-cargs:lang opts] ");
4175          end loop;
4176
4177          Write_Str ("[-largs opts] [-gargs opts]}");
4178          Write_Eol;
4179          Write_Eol;
4180          Write_Str ("  name is zero or more file names");
4181          Write_Eol;
4182          Write_Eol;
4183
4184          --  GPRMAKE switches
4185
4186          Write_Str ("gprmake switches:");
4187          Write_Eol;
4188
4189          --  Line for -c
4190
4191          Write_Str ("  -c       Compile only");
4192          Write_Eol;
4193
4194          --  Line for -f
4195
4196          Write_Str ("  -f       Force recompilations");
4197          Write_Eol;
4198
4199          --  Line for -k
4200
4201          Write_Str ("  -k       Keep going after compilation errors");
4202          Write_Eol;
4203
4204          --  Line for -o
4205
4206          Write_Str ("  -o name  Choose an alternate executable name");
4207          Write_Eol;
4208
4209          --  Line for -P
4210
4211          Write_Str ("  -Pproj   Use GNAT Project File proj");
4212          Write_Eol;
4213
4214          --  Line for -q
4215
4216          Write_Str ("  -q       Be quiet/terse");
4217          Write_Eol;
4218
4219          --  Line for -u
4220
4221          Write_Str
4222            ("  -u       Unique compilation. Only compile the given files");
4223          Write_Eol;
4224
4225          --  Line for -v
4226
4227          Write_Str ("  -v       Verbose output");
4228          Write_Eol;
4229
4230          --  Line for -vPx
4231
4232          Write_Str ("  -vPx     Specify verbosity when parsing Project Files");
4233          Write_Eol;
4234
4235          --  Line for -X
4236
4237          Write_Str ("  -Xnm=val Specify an external reference for " &
4238                     "Project Files");
4239          Write_Eol;
4240          Write_Eol;
4241
4242          --  Line for -cargs
4243
4244          Write_Line ("  -cargs opts     opts are passed to the Ada compiler");
4245
4246          --  Line for -cargs:lang
4247
4248          Write_Line ("  -cargs:<lang> opts");
4249          Write_Line ("     opts are passed to the compiler " &
4250                      "for language < lang > ");
4251
4252          --  Line for -largs
4253
4254          Write_Str ("  -largs opts    opts are passed to the linker");
4255          Write_Eol;
4256
4257          --  Line for -gargs
4258
4259          Write_Str ("  -gargs opts    opts directly interpreted by gprmake");
4260          Write_Eol;
4261          Write_Eol;
4262
4263       end if;
4264    end Usage;
4265
4266 begin
4267    Makeutl.Do_Fail := Report_Error'Access;
4268 end Makegpr;