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