gcc/ada/makegpr.adb

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