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