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