]> gcc.gnu.org Git - gcc.git/blame - gcc/ada/makegpr.adb
git://gcc.gnu.org / gcc.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
re PR fortran/13792 (lbound/ubound generates internal compiler error)
[gcc.git] / gcc / ada / makegpr.adb
CommitLineData
9f4fd324
AC		 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
27with Ada.Command_Line; use Ada.Command_Line;
28with Ada.Strings.Fixed; use Ada.Strings.Fixed;
29with Ada.Text_IO; use Ada.Text_IO;
30with Ada.Unchecked_Deallocation;
31
32with Csets;
33with Gnatvsn;
34
35with GNAT.Directory_Operations; use GNAT.Directory_Operations;
36with GNAT.Dynamic_Tables;
37with GNAT.Expect; use GNAT.Expect;
38with GNAT.HTable;
39with GNAT.OS_Lib; use GNAT.OS_Lib;
40with GNAT.Regpat; use GNAT.Regpat;
41
42with Makeutl; use Makeutl;
43with MLib.Tgt; use MLib.Tgt;
44with Namet; use Namet;
45with Output; use Output;
46with Opt; use Opt;
47with Osint; use Osint;
48with Prj; use Prj;
49with Prj.Com; use Prj.Com;
50with Prj.Pars;
51with Prj.Util; use Prj.Util;
52with Snames; use Snames;
53with System;
54with System.Case_Util; use System.Case_Util;
55with Table;
56with Types; use Types;
57
58package 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);
0da2c8ac 69 -- Null argument list representing case of no arguments
9f4fd324
AC		 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
0da2c8ac
AC		 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
9f4fd324
AC		 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
0da2c8ac
AC		 87 Project : Project_Id;
88 Id : Other_Source_Id;
89 Found : Boolean := False;
9f4fd324 90 end record;
0da2c8ac 91 -- Used as Source_Indexes component to check if archive needs to be rebuilt
9f4fd324
AC		 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;
0da2c8ac 129 -- Flags to avoid multiple displays of Copyright notice and of Usage
9f4fd324
AC		 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;
0da2c8ac 157 -- List of the packages to be checked when parsing/processing project files
9f4fd324
AC		 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
9f4fd324
AC		 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
15ce9ca2
AC		 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
9f4fd324
AC		 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
0da2c8ac
AC		 309 Need_To_Rebuild_Global_Archive : Boolean := False;
310
9f4fd324
AC		 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
15ce9ca2
AC		 317 Global_Archive_Exists : Boolean := False;
318 -- True if there is a non empty global archive, to prevent creation
319 -- of such archives.
320
9f4fd324
AC		 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
0da2c8ac
AC		 350 (Data : Project_Data;
351 Language : Programming_Language);
9f4fd324
AC		 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
0da2c8ac 356 procedure Add_Source_Id (Project : Project_Id; Id : Other_Source_Id);
9f4fd324
AC		 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
0da2c8ac
AC		 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
aa720a54 374 -- if it is not.
9f4fd324 375
0da2c8ac
AC		 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
9f4fd324
AC		 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;
aa720a54 394 Data : Project_Data;
9f4fd324 395 Local_Errors : in out Boolean);
0da2c8ac 396 -- Compile one non-Ada source
9f4fd324
AC		 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
aa720a54
AC		 404 -- project. Arguments may already contain options to be used by
405 -- gnatmake. Used for both Ada mains and mains of other languages.
9f4fd324
AC		 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
aa720a54
AC		 415 (Name : String;
416 First_Source : Other_Source_Id);
0da2c8ac
AC		 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
9f4fd324 421
5453d5bd
AC		 422 procedure Display_Command
423 (Name : String;
424 Path : String_Access;
425 CPATH : String_Access := null);
9f4fd324
AC		 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
0da2c8ac
AC		 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
9f4fd324
AC		 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;
0da2c8ac 470 -- Remove characters ASCII.CR and ASCII.LF from a String
9f4fd324
AC		 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
0da2c8ac
AC		 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
15ce9ca2 583 -- is the one for the main project, if there is one.
0da2c8ac 584
15ce9ca2 585 elsif Project = Main_Project and then Global_Archive_Exists then
0da2c8ac
AC		 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
9f4fd324
AC		 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
aa720a54 604
9f4fd324
AC		 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
0da2c8ac
AC		 632 if Project = Main_Project
633 or else Data.Other_Sources_Present
634 then
635 Add_Archive_Path;
9f4fd324
AC		 636 end if;
637 end if;
638 end if;
639 end Recursive_Add_Archives;
640
0da2c8ac
AC		 641 -- Start of processing for Add_Archives
642
9f4fd324
AC		 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
aa720a54 689
9f4fd324
AC		 690 -- Reallocate arrays if necessary
691
692 if Last_Argument = Arguments'Last then
693 declare
694 New_Arguments : constant Argument_List_Access :=
aa720a54
AC		 695 new Argument_List
696 (1 .. Last_Argument +
697 Initial_Argument_Count);
698
9f4fd324 699 New_Arguments_Displayed : constant Booleans :=
aa720a54
AC		 700 new Boolean_Array
701 (1 .. Last_Argument +
702 Initial_Argument_Count);
9f4fd324
AC		 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;
aa720a54 732
9f4fd324
AC		 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 :=
0da2c8ac
AC		 773 new Argument_List
774 (1 .. Last_Argument + Args'Length +
775 Initial_Argument_Count);
776
9f4fd324 777 New_Arguments_Displayed : constant Booleans :=
0da2c8ac
AC		 778 new Boolean_Array
779 (1 .. Last_Argument +
780 Args'Length +
781 Initial_Argument_Count);
9f4fd324
AC		 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);
aa720a54 815
9f4fd324
AC		 816 begin
817 case Current_Processor is
818 when None =>
819 null;
820
821 when Linker =>
aa720a54 822
9f4fd324
AC		 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 =>
aa720a54 829
9f4fd324
AC		 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
0da2c8ac 844 procedure Add_Source_Id (Project : Project_Id; Id : Other_Source_Id) is
9f4fd324
AC		 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 :=
aa720a54
AC		 851 new Source_Index_Array
852 (1 .. Source_Indexes'Last +
853 Initial_Source_Index_Count);
9f4fd324
AC		 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;
0da2c8ac 862 Source_Indexes (Last_Source) := (Project, Id, False);
9f4fd324
AC		 863 end Add_Source_Id;
864
865 ----------------------------
866 -- Add_Search_Directories --
867 ----------------------------
868
869 procedure Add_Search_Directories
aa720a54
AC		 870 (Data : Project_Data;
871 Language : Programming_Language)
9f4fd324
AC		 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
aa720a54 928
9f4fd324
AC		 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
aa720a54
AC		 936 (Index => File_Name,
937 Src_Index => 0,
938 In_Array => Switches_Array);
9f4fd324
AC		 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
aa720a54
AC		 947 (Index => Lang_Name_Ids (Language),
948 Src_Index => 0,
949 In_Array => Defaults);
9f4fd324
AC		 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;
9f4fd324
AC		 956 while Element_Id /= Nil_String loop
957 Element := String_Elements.Table (Element_Id);
958
959 if Element.Value /= No_Name then
0da2c8ac
AC		 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);
9f4fd324
AC		 972 end if;
973
974 Element_Id := Element.Next;
975 end loop;
976 end if;
977 end Add_Switches;
978
0da2c8ac
AC		 979 --------------------------
980 -- Build_Global_Archive --
981 --------------------------
9f4fd324 982
0da2c8ac
AC		 983 procedure Build_Global_Archive is
984 Data : Project_Data := Projects.Table (Main_Project);
9f4fd324
AC		 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
0da2c8ac 997 Need_To_Rebuild : Boolean := Need_To_Rebuild_Global_Archive;
9f4fd324
AC		 998 -- When True, archive will be rebuilt
999
1000 File : Prj.Util.Text_File;
1001
0da2c8ac
AC		 1002 Object_Path : Name_Id;
1003 Time_Stamp : Time_Stamp_Type;
9f4fd324
AC		 1004
1005 Saved_Last_Argument : Natural;
0da2c8ac
AC		 1006 First_Object : Natural;
1007
1008 Discard : Boolean;
aa720a54 1009
9f4fd324 1010 begin
0da2c8ac 1011 Check_Archive_Builder;
9f4fd324 1012
0da2c8ac 1013 Change_Dir (Get_Name_String (Data.Object_Directory));
9f4fd324 1014
0da2c8ac
AC		 1015 if not Need_To_Rebuild then
1016 if Verbose_Mode then
1017 Write_Str (" Checking ");
1018 Write_Line (Archive_Name);
9f4fd324
AC		 1019 end if;
1020
0da2c8ac 1021 -- If the archive does not exist, of course it needs to be built
9f4fd324 1022
0da2c8ac
AC		 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
0da2c8ac
AC		 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
15ce9ca2
AC		 1219 -- No need to create a global archive, if there is no object
1220 -- file to put into.
0da2c8ac 1221
15ce9ca2 1222 Global_Archive_Exists := Last_Argument > First_Object;
0da2c8ac 1223
15ce9ca2
AC		 1224 if Global_Archive_Exists then
1225 -- If the archive is built, then linking will need to occur
1226 -- unconditionally.
0da2c8ac 1227
15ce9ca2 1228 Need_To_Relink := True;
0da2c8ac 1229
15ce9ca2 1230 -- Spawn the archive builder (ar)
0da2c8ac 1231
15ce9ca2 1232 Saved_Last_Argument := Last_Argument;
0da2c8ac 1233
15ce9ca2 1234 Last_Argument := First_Object + Max_In_Archives;
0da2c8ac 1235
15ce9ca2
AC		 1236 loop
1237 if Last_Argument > Saved_Last_Argument then
1238 Last_Argument := Saved_Last_Argument;
1239 end if;
0da2c8ac 1240
15ce9ca2 1241 Display_Command (Archive_Builder, Archive_Builder_Path);
0da2c8ac 1242
15ce9ca2
AC		 1243 Spawn
1244 (Archive_Builder_Path.all,
1245 Arguments (1 .. Last_Argument),
1246 Success);
0da2c8ac 1247
15ce9ca2 1248 exit when not Success;
0da2c8ac 1249
15ce9ca2
AC		 1250 exit when Last_Argument = Saved_Last_Argument;
1251
1252 Arguments (1) := r;
1253 Arguments (3 .. Saved_Last_Argument - Last_Argument + 2) :=
1254 Arguments (Last_Argument + 1 .. Saved_Last_Argument);
1255 Saved_Last_Argument := Saved_Last_Argument - Last_Argument + 2;
1256 end loop;
1257
1258 -- If the archive was built, run the archive indexer (ranlib)
0da2c8ac
AC		 1259 -- if there is one.
1260
15ce9ca2 1261 if Success then
0da2c8ac 1262
15ce9ca2
AC		 1263 -- If the archive was built, run the archive indexer (ranlib),
1264 -- if there is one.
0da2c8ac 1265
15ce9ca2
AC		 1266 if Archive_Indexer_Path /= null then
1267 Last_Argument := 0;
1268 Add_Argument (Archive_Name, True);
0da2c8ac 1269
15ce9ca2 1270 Display_Command (Archive_Indexer, Archive_Indexer_Path);
0da2c8ac 1271
15ce9ca2
AC		 1272 Spawn
1273 (Archive_Indexer_Path.all, Arguments (1 .. 1), Success);
0da2c8ac 1274
15ce9ca2
AC		 1275 if not Success then
1276
1277 -- Running ranlib failed, delete the dependency file,
1278 -- if it exists.
1279
1280 if Is_Regular_File (Archive_Dep_Name) then
1281 Delete_File (Archive_Dep_Name, Success);
1282 end if;
0da2c8ac 1283
15ce9ca2 1284 -- And report the error
0da2c8ac 1285
15ce9ca2
AC		 1286 Report_Error
1287 ("running" & Archive_Indexer & " for project """,
1288 Get_Name_String (Data.Name),
1289 """ failed");
1290 return;
1291 end if;
0da2c8ac 1292 end if;
0da2c8ac 1293
15ce9ca2 1294 -- The archive was correctly built, create its dependency file
0da2c8ac 1295
15ce9ca2 1296 Create_Global_Archive_Dependency_File (Archive_Dep_Name);
0da2c8ac 1297
15ce9ca2
AC		 1298 -- Building the archive failed, delete dependency file if one
1299 -- exists.
0da2c8ac 1300
15ce9ca2
AC		 1301 else
1302 if Is_Regular_File (Archive_Dep_Name) then
1303 Delete_File (Archive_Dep_Name, Success);
1304 end if;
0da2c8ac 1305
15ce9ca2 1306 -- And report the error
0da2c8ac 1307
15ce9ca2
AC		 1308 Report_Error
1309 ("building archive for project """,
1310 Get_Name_String (Data.Name),
1311 """ failed");
1312 end if;
9f4fd324
AC		 1313 end if;
1314 end if;
0da2c8ac
AC		 1315 end Build_Global_Archive;
1316
1317 -------------------
1318 -- Build_Library --
1319 -------------------
1320
1321 procedure Build_Library (Project : Project_Id; Unconditionally : Boolean) is
1322 Data : constant Project_Data := Projects.Table (Project);
1323 Source_Id : Other_Source_Id;
1324 Source : Other_Source;
1325
1326 Archive_Name : constant String :=
1327 "lib" & Get_Name_String (Data.Name) & '.' & Archive_Ext;
1328 -- The name of the archive file for this project
1329
1330 Archive_Dep_Name : constant String :=
1331 "lib" & Get_Name_String (Data.Name) & ".deps";
1332 -- The name of the archive dependency file for this project
1333
1334 Need_To_Rebuild : Boolean := Unconditionally;
1335 -- When True, archive will be rebuilt
1336
1337 File : Prj.Util.Text_File;
1338
1339 Object_Name : Name_Id;
1340 Time_Stamp : Time_Stamp_Type;
1341
1342 begin
1343 Check_Archive_Builder;
9f4fd324
AC		 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
aa720a54
AC		 1362 -- Archive does exist
1363
9f4fd324
AC		 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
0da2c8ac 1382 -- Put all sources of language other than Ada in Source_Indexes
9f4fd324
AC		 1383
1384 Last_Source := 0;
1385 Source_Id := Data.First_Other_Source;
1386
1387 while Source_Id /= No_Other_Source loop
0da2c8ac 1388 Add_Source_Id (Project, Source_Id);
9f4fd324
AC		 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
aa720a54 1402 -- Check if this object file is for a source of this project
9f4fd324
AC		 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;
0da2c8ac 1425
9f4fd324
AC		 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
aa720a54 1490
9f4fd324
AC		 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
0da2c8ac 1520 -- Build the library if necessary
9f4fd324
AC		 1521
1522 if Need_To_Rebuild then
aa720a54 1523
0da2c8ac 1524 -- If a library is built, then linking will need to occur
9f4fd324
AC		 1525 -- unconditionally.
1526
1527 Need_To_Relink := True;
1528
1529 Last_Argument := 0;
1530
9f4fd324
AC		 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
aa720a54 1535
9f4fd324
AC		 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 MLib.Tgt.Build_Dynamic_Library
1559 (Ofiles => Arguments (1 .. Last_Argument),
1560 Foreign => Arguments (1 .. Last_Argument),
1561 Afiles => No_Argument,
1562 Options => No_Argument,
1563 Interfaces => No_Argument,
1564 Lib_Filename => Get_Name_String (Data.Library_Name),
1565 Lib_Dir => Get_Name_String (Data.Library_Dir),
1566 Symbol_Data => No_Symbols,
1567 Driver_Name => No_Name,
9f4fd324 1568 Lib_Version => "",
9f4fd324
AC		 1569 Auto_Init => False);
1570 end if;
0da2c8ac 1571 end if;
9f4fd324 1572
0da2c8ac 1573 -- Create fake empty archive, so we can check its time stamp later
9f4fd324 1574
0da2c8ac
AC		 1575 declare
1576 Archive : Ada.Text_IO.File_Type;
1577 use Ada.Text_IO;
1578 begin
1579 Create (Archive, Out_File, Archive_Name);
1580 Close (Archive);
1581 end;
9f4fd324 1582
0da2c8ac
AC		 1583 Create_Archive_Dependency_File
1584 (Archive_Dep_Name, Data.First_Other_Source);
9f4fd324 1585
0da2c8ac
AC		 1586 end if;
1587 end Build_Library;
9f4fd324 1588
0da2c8ac
AC		 1589 -----------
1590 -- Check --
1591 -----------
aa720a54 1592
0da2c8ac
AC		 1593 procedure Check (Option : String) is
1594 First : Positive := Option'First;
1595 Last : Natural;
9f4fd324 1596
0da2c8ac
AC		 1597 begin
1598 for Index in Option'First + 1 .. Option'Last - 1 loop
1599 if Option (Index) = ' ' and then Option (Index + 1) = '-' then
1600 Write_Str ("warning: switch """);
1601 Write_Str (Option);
1602 Write_Str (""" is suspicious; consider using ");
1603
1604 Last := First;
1605 while Last <= Option'Last loop
1606 if Option (Last) = ' ' then
1607 if First /= Option'First then
1608 Write_Str (", ");
1609 end if;
9f4fd324 1610
0da2c8ac
AC		 1611 Write_Char ('"');
1612 Write_Str (Option (First .. Last - 1));
1613 Write_Char ('"');
9f4fd324 1614
0da2c8ac
AC		 1615 while Last <= Option'Last and then Option (Last) = ' ' loop
1616 Last := Last + 1;
1617 end loop;
9f4fd324 1618
0da2c8ac 1619 First := Last;
aa720a54 1620
0da2c8ac
AC		 1621 else
1622 if Last = Option'Last then
1623 if First /= Option'First then
1624 Write_Str (", ");
1625 end if;
9f4fd324 1626
0da2c8ac
AC		 1627 Write_Char ('"');
1628 Write_Str (Option (First .. Last));
1629 Write_Char ('"');
9f4fd324
AC		 1630 end if;
1631
0da2c8ac 1632 Last := Last + 1;
9f4fd324 1633 end if;
0da2c8ac 1634 end loop;
9f4fd324 1635
0da2c8ac
AC		 1636 Write_Line (" instead");
1637 exit;
1638 end if;
1639 end loop;
1640 end Check;
9f4fd324 1641
0da2c8ac
AC		 1642 ---------------------------
1643 -- Check_Archive_Builder --
1644 ---------------------------
9f4fd324 1645
0da2c8ac
AC		 1646 procedure Check_Archive_Builder is
1647 begin
1648 -- First, make sure that the archive builder (ar) is on the path
9f4fd324 1649
0da2c8ac
AC		 1650 if Archive_Builder_Path = null then
1651 Archive_Builder_Path := Locate_Exec_On_Path (Archive_Builder);
9f4fd324 1652
0da2c8ac
AC		 1653 if Archive_Builder_Path = null then
1654 Osint.Fail
1655 ("unable to locate archive builder """,
1656 Archive_Builder,
1657 """");
1658 end if;
9f4fd324 1659
0da2c8ac
AC		 1660 -- If there is an archive indexer (ranlib), try to locate it on the
1661 -- path. Don't fail if it is not found.
1662
1663 if Archive_Indexer /= "" then
1664 Archive_Indexer_Path := Locate_Exec_On_Path (Archive_Indexer);
9f4fd324
AC		 1665 end if;
1666 end if;
0da2c8ac 1667 end Check_Archive_Builder;
9f4fd324
AC		 1668
1669 ------------------------------
1670 -- Check_Compilation_Needed --
1671 ------------------------------
1672
1673 procedure Check_Compilation_Needed
1674 (Source : Other_Source;
1675 Need_To_Compile : out Boolean)
1676 is
1677 Source_Name : constant String := Get_Name_String (Source.File_Name);
1678 Source_Path : constant String := Get_Name_String (Source.Path_Name);
1679 Object_Name : constant String := Get_Name_String (Source.Object_Name);
1680 Dep_Name : constant String := Get_Name_String (Source.Dep_Name);
1681
1682 Source_In_Dependencies : Boolean := False;
0da2c8ac 1683 -- Set True if source was found in dependency file of its object file
9f4fd324
AC		 1684
1685 Dep_File : Prj.Util.Text_File;
aa720a54
AC		 1686 Start : Natural;
1687 Finish : Natural;
1688
9f4fd324
AC		 1689 begin
1690 -- Assume the worst, so that statement "return;" may be used if there
1691 -- is any problem.
1692
1693 Need_To_Compile := True;
1694
1695 if Verbose_Mode then
1696 Write_Str (" Checking ");
1697 Write_Str (Source_Name);
1698 Write_Line (" ... ");
1699 end if;
1700
0da2c8ac 1701 -- If object file does not exist, of course source need to be compiled
9f4fd324
AC		 1702
1703 if Source.Object_TS = Empty_Time_Stamp then
1704 if Verbose_Mode then
1705 Write_Str (" -> object file ");
1706 Write_Str (Object_Name);
1707 Write_Line (" does not exist");
1708 end if;
1709
1710 return;
1711 end if;
1712
1713 -- If the object file has been created before the last modification
1714 -- of the source, the source need to be recompiled.
1715
1716 if Source.Object_TS < Source.Source_TS then
1717 if Verbose_Mode then
1718 Write_Str (" -> object file ");
1719 Write_Str (Object_Name);
1720 Write_Line (" has time stamp earlier than source");
1721 end if;
1722
1723 return;
1724 end if;
1725
1726 -- If there is no dependency file, then the source needs to be
1727 -- recompiled and the dependency file need to be created.
1728
1729 if Source.Dep_TS = Empty_Time_Stamp then
1730 if Verbose_Mode then
1731 Write_Str (" -> dependency file ");
1732 Write_Str (Dep_Name);
1733 Write_Line (" does not exist");
1734 end if;
1735
1736 return;
1737 end if;
1738
1739 -- The source needs to be recompiled if the source has been modified
1740 -- after the dependency file has been created.
1741
1742 if Source.Dep_TS < Source.Source_TS then
1743 if Verbose_Mode then
1744 Write_Str (" -> dependency file ");
1745 Write_Str (Dep_Name);
1746 Write_Line (" has time stamp earlier than source");
1747 end if;
1748
1749 return;
1750 end if;
1751
1752 -- Look for all dependencies
1753
1754 Open (Dep_File, Dep_Name);
1755
aa720a54 1756 -- If dependency file cannot be open, we need to recompile the source
9f4fd324
AC		 1757
1758 if not Is_Valid (Dep_File) then
1759 if Verbose_Mode then
1760 Write_Str (" -> could not open dependency file ");
1761 Write_Line (Dep_Name);
1762 end if;
1763
1764 return;
1765 end if;
1766
1767 declare
1768 End_Of_File_Reached : Boolean := False;
aa720a54 1769
9f4fd324
AC		 1770 begin
1771 loop
1772 if End_Of_File (Dep_File) then
1773 End_Of_File_Reached := True;
1774 exit;
1775 end if;
1776
1777 Get_Line (Dep_File, Name_Buffer, Name_Len);
1778
1779 exit when Name_Len > 0 and then Name_Buffer (1) /= '#';
1780 end loop;
1781
1782 -- If dependency file contains only empty lines or comments, then
0da2c8ac 1783 -- dependencies are unknown, and the source needs to be recompiled.
9f4fd324
AC		 1784
1785 if End_Of_File_Reached then
1786 if Verbose_Mode then
1787 Write_Str (" -> dependency file ");
1788 Write_Str (Dep_Name);
1789 Write_Line (" is empty");
1790 end if;
1791
1792 Close (Dep_File);
1793 return;
1794 end if;
1795 end;
1796
1797 Start := 1;
1798 Finish := Index (Name_Buffer (1 .. Name_Len), ": ");
1799
0da2c8ac 1800 -- First line must start with name of object file, followed by colon
9f4fd324
AC		 1801
1802 if Finish = 0 or else Name_Buffer (1 .. Finish - 1) /= Object_Name then
1803 if Verbose_Mode then
1804 Write_Str (" -> dependency file ");
1805 Write_Str (Dep_Name);
1806 Write_Line (" has wrong format");
1807 end if;
1808
1809 Close (Dep_File);
1810 return;
1811
1812 else
1813 Start := Finish + 2;
1814
1815 -- Process each line
1816
1817 Line_Loop : loop
1818 declare
0da2c8ac 1819 Line : constant String := Name_Buffer (1 .. Name_Len);
9f4fd324 1820 Last : constant Natural := Name_Len;
aa720a54 1821
9f4fd324
AC		 1822 begin
1823 Name_Loop : loop
aa720a54 1824
9f4fd324
AC		 1825 -- Find the beginning of the next source path name
1826
1827 while Start < Last and then Line (Start) = ' ' loop
1828 Start := Start + 1;
1829 end loop;
1830
1831 -- Go to next line when there is a continuation character \
1832 -- at the end of the line.
1833
1834 exit Name_Loop when Start = Last
1835 and then Line (Start) = '\';
1836
1837 -- We should not be at the end of the line, without
1838 -- a continuation character \.
1839
1840 if Start = Last then
1841 if Verbose_Mode then
1842 Write_Str (" -> dependency file ");
1843 Write_Str (Dep_Name);
1844 Write_Line (" has wrong format");
1845 end if;
1846
1847 Close (Dep_File);
1848 return;
1849 end if;
1850
1851 -- Look for the end of the source path name
1852
1853 Finish := Start;
1854 while Finish < Last and then Line (Finish + 1) /= ' ' loop
1855 Finish := Finish + 1;
1856 end loop;
1857
1858 -- Check this source
1859
1860 declare
1861 Src_Name : constant String :=
aa720a54
AC		 1862 Normalize_Pathname
1863 (Name => Line (Start .. Finish),
1864 Case_Sensitive => False);
9f4fd324 1865 Src_TS : Time_Stamp_Type;
aa720a54 1866
9f4fd324 1867 begin
aa720a54 1868 -- If it is original source, set Source_In_Dependencies
9f4fd324
AC		 1869
1870 if Src_Name = Source_Path then
1871 Source_In_Dependencies := True;
1872 end if;
1873
1874 Name_Len := 0;
1875 Add_Str_To_Name_Buffer (Src_Name);
1876 Src_TS := File_Stamp (Name_Find);
1877
1878 -- If the source does not exist, we need to recompile
1879
1880 if Src_TS = Empty_Time_Stamp then
1881 if Verbose_Mode then
1882 Write_Str (" -> source ");
1883 Write_Str (Src_Name);
1884 Write_Line (" does not exist");
1885 end if;
1886
1887 Close (Dep_File);
1888 return;
1889
1890 -- If the source has been modified after the object file,
1891 -- we need to recompile.
1892
1893 elsif Src_TS > Source.Object_TS then
1894 if Verbose_Mode then
1895 Write_Str (" -> source ");
1896 Write_Str (Src_Name);
1897 Write_Line
1898 (" has time stamp later than object file");
1899 end if;
1900
1901 Close (Dep_File);
1902 return;
1903 end if;
1904 end;
1905
1906 -- If the source path name ends the line, we are done.
1907
1908 exit Line_Loop when Finish = Last;
1909
1910 -- Go get the next source on the line
1911
1912 Start := Finish + 1;
1913 end loop Name_Loop;
1914 end;
1915
1916 -- If we are here, we had a continuation character \ at the end
1917 -- of the line, so we continue with the next line.
1918
1919 Get_Line (Dep_File, Name_Buffer, Name_Len);
1920 Start := 1;
1921 end loop Line_Loop;
1922 end if;
1923
1924 Close (Dep_File);
1925
1926 -- If the original sources were not in the dependency file, then we
1927 -- need to recompile. It may mean that we are using a different source
1928 -- (different variant) for this object file.
1929
1930 if not Source_In_Dependencies then
1931 if Verbose_Mode then
1932 Write_Str (" -> source ");
1933 Write_Str (Source_Path);
1934 Write_Line (" is not in the dependencies");
1935 end if;
1936
1937 return;
1938 end if;
1939
1940 -- If we are here, then everything is OK, and we don't need
1941 -- to recompile.
1942
1943 if Verbose_Mode then
1944 Write_Line (" -> up to date");
1945 end if;
1946
1947 Need_To_Compile := False;
1948 end Check_Compilation_Needed;
1949
1950 ---------------------------
1951 -- Check_For_C_Plus_Plus --
1952 ---------------------------
1953
1954 procedure Check_For_C_Plus_Plus is
1955 begin
1956 C_Plus_Plus_Is_Used := False;
1957
1958 for Project in 1 .. Projects.Last loop
1959 if Projects.Table (Project).Languages (Lang_C_Plus_Plus) then
1960 C_Plus_Plus_Is_Used := True;
1961 exit;
1962 end if;
1963 end loop;
1964 end Check_For_C_Plus_Plus;
1965
1966 -------------
1967 -- Compile --
1968 -------------
1969
1970 procedure Compile
1971 (Source_Id : Other_Source_Id;
1972 Data : in Project_Data;
1973 Local_Errors : in out Boolean)
1974 is
1975 Source : Other_Source := Other_Sources.Table (Source_Id);
1976 Success : Boolean;
5453d5bd 1977 CPATH : String_Access := null;
aa720a54 1978
9f4fd324 1979 begin
0da2c8ac 1980 -- If the compiler is not known yet, get its path name
9f4fd324
AC		 1981
1982 if Compiler_Names (Source.Language) = null then
1983 Get_Compiler (Source.Language);
1984 end if;
1985
0da2c8ac 1986 -- For non GCC compilers, get the dependency file, first calling the
9f4fd324
AC		 1987 -- compiler with the switch -M.
1988
1989 if not Compiler_Is_Gcc (Source.Language) then
1990 Last_Argument := 0;
1991
1992 -- Add the source name, preceded by -M
1993
1994 Add_Argument (Dash_M, True);
1995 Add_Argument (Get_Name_String (Source.Path_Name), True);
1996
1997 -- Add the compiling switches for this source found in
1998 -- package Compiler of the project file, if they exist.
1999
2000 Add_Switches
2001 (Data, Compiler, Source.Language, Source.File_Name);
2002
2003 -- Add the compiling switches for the language specified
2004 -- on the command line, if any.
2005
2006 for
2007 J in 1 .. Comp_Opts.Last (Options (Source.Language))
2008 loop
2009 Add_Argument (Options (Source.Language).Table (J), True);
2010 end loop;
2011
0da2c8ac 2012 -- Finally, add imported directory switches for this project file
9f4fd324
AC		 2013
2014 Add_Search_Directories (Data, Source.Language);
2015
2016 -- And invoke the compiler using GNAT.Expect
2017
2018 Display_Command
2019 (Compiler_Names (Source.Language).all,
2020 Compiler_Paths (Source.Language));
2021
2022 begin
2023 Non_Blocking_Spawn
2024 (FD,
2025 Compiler_Paths (Source.Language).all,
2026 Arguments (1 .. Last_Argument),
2027 Buffer_Size => 0,
2028 Err_To_Out => True);
2029
2030 declare
2031 Dep_File : Ada.Text_IO.File_Type;
2032 Result : Expect_Match;
2033 Status : Integer;
2034
2035 begin
2036 -- Create the dependency file
2037
2038 Create (Dep_File, Out_File, Get_Name_String (Source.Dep_Name));
2039
2040 loop
2041 Expect (FD, Result, Line_Matcher);
2042
2043 exit when Result = Expect_Timeout;
2044
2045 declare
2046 S : constant String := Strip_CR_LF (Expect_Out (FD));
aa720a54 2047
9f4fd324
AC		 2048 begin
2049 -- Each line of the output is put in the dependency
2050 -- file, including errors. If there are errors, the
2051 -- syntax of the dependency file will be incorrect and
2052 -- recompilation will occur automatically the next time
2053 -- the dependencies are checked.
2054
2055 Put_Line (Dep_File, S);
2056 end;
2057 end loop;
2058
aa720a54
AC		 2059 -- If we are here, it means we had a timeout, so the
2060 -- dependency file may be incomplete. It is safer to
9f4fd324
AC		 2061 -- delete it, otherwise the dependencies may be wrong.
2062
2063 Close (FD, Status);
2064 Close (Dep_File);
2065 Delete_File (Get_Name_String (Source.Dep_Name), Success);
2066
2067 exception
aa720a54
AC		 2068 when Process_Died =>
2069
2070 -- This is the normal outcome. Just close the file
9f4fd324
AC		 2071
2072 Close (FD, Status);
2073 Close (Dep_File);
2074
aa720a54
AC		 2075 when others =>
2076
9f4fd324
AC		 2077 -- Something wrong happened. It is safer to delete the
2078 -- dependency file, otherwise the dependencies may be wrong.
2079
2080 Close (FD, Status);
2081
2082 if Is_Open (Dep_File) then
2083 Close (Dep_File);
2084 end if;
2085
2086 Delete_File (Get_Name_String (Source.Dep_Name), Success);
2087 end;
2088
2089 exception
2090 -- If we cannot spawn the compiler, then the dependencies are
2091 -- not updated. It is safer then to delete the dependency file,
2092 -- otherwise the dependencies may be wrong.
2093
2094 when Invalid_Process =>
2095 Delete_File (Get_Name_String (Source.Dep_Name), Success);
2096 end;
2097 end if;
2098
2099 Last_Argument := 0;
2100
aa720a54
AC		 2101 -- For GCC compilers, make sure the language is always specified to
2102 -- to the GCC driver, in case the extension is not recognized by the
2103 -- GCC driver as a source of the language.
9f4fd324
AC		 2104
2105 if Compiler_Is_Gcc (Source.Language) then
2106 Add_Argument (Dash_x, Verbose_Mode);
2107 Add_Argument
2108 (Lang_Names (Source.Language), Verbose_Mode);
2109 end if;
2110
2111 -- Specify the source to be compiled
aa720a54 2112
9f4fd324
AC		 2113 Add_Argument (Dash_c, True);
2114 Add_Argument (Get_Name_String (Source.Path_Name), True);
2115
aa720a54
AC		 2116 -- If non static library project, compile with the PIC option if there
2117 -- is one (when there is no PIC option, function MLib.Tgt.PIC_Option
2118 -- returns an empty string, and Add_Argument with an empty string has
2119 -- no effect).
9f4fd324
AC		 2120
2121 if Data.Library and then Data.Library_Kind /= Static then
2122 Add_Argument (PIC_Option, True);
2123 end if;
2124
2125 -- Indicate the name of the object
2126
2127 Add_Argument (Dash_o, True);
2128 Add_Argument (Get_Name_String (Source.Object_Name), True);
2129
2130 -- When compiler is GCC, use the magic switch that creates
2131 -- the dependency file in the correct format.
2132
2133 if Compiler_Is_Gcc (Source.Language) then
2134 Add_Argument
2135 ("-Wp,-MD," & Get_Name_String (Source.Dep_Name),
2136 Verbose_Mode);
2137 end if;
2138
2139 -- Add the compiling switches for this source found in
2140 -- package Compiler of the project file, if they exist.
2141
2142 Add_Switches
2143 (Data, Compiler, Source.Language, Source.File_Name);
2144
2145 -- Add the compiling switches for the language specified
2146 -- on the command line, if any.
2147
0da2c8ac 2148 for J in 1 .. Comp_Opts.Last (Options (Source.Language)) loop
9f4fd324
AC		 2149 Add_Argument (Options (Source.Language).Table (J), True);
2150 end loop;
2151
2152 -- Finally, add the imported directory switches for this
2153 -- project file (or, for gcc compilers, set up the CPATH env var
2154 -- if needed).
2155
2156 Add_Search_Directories (Data, Source.Language);
2157
5453d5bd
AC		 2158 -- Set CPATH, if compiler is GCC
2159
2160 if Compiler_Is_Gcc (Source.Language) then
2161 CPATH := Current_Include_Paths (Source.Language);
2162 end if;
2163
9f4fd324
AC		 2164 -- And invoke the compiler
2165
2166 Display_Command
5453d5bd
AC		 2167 (Name => Compiler_Names (Source.Language).all,
2168 Path => Compiler_Paths (Source.Language),
2169 CPATH => CPATH);
9f4fd324
AC		 2170
2171 Spawn
2172 (Compiler_Paths (Source.Language).all,
2173 Arguments (1 .. Last_Argument),
2174 Success);
2175
0da2c8ac
AC		 2176 -- Case of successful compilation
2177
9f4fd324 2178 if Success then
aa720a54 2179
0da2c8ac 2180 -- Update the time stamp of the object file
9f4fd324
AC		 2181
2182 Source.Object_TS := File_Stamp (Source.Object_Name);
2183
2184 -- Do some sanity checks
2185
2186 if Source.Object_TS = Empty_Time_Stamp then
2187 Local_Errors := True;
2188 Report_Error
2189 ("object file ",
2190 Get_Name_String (Source.Object_Name),
2191 " has not been created");
2192
2193 elsif Source.Object_TS < Source.Source_TS then
2194 Local_Errors := True;
2195 Report_Error
2196 ("object file ",
2197 Get_Name_String (Source.Object_Name),
2198 " has not been modified");
2199
2200 else
aa720a54 2201 -- Everything looks fine, update the Other_Sources table
9f4fd324
AC		 2202
2203 Other_Sources.Table (Source_Id) := Source;
2204 end if;
2205
0da2c8ac
AC		 2206 -- Compilation failed
2207
9f4fd324
AC		 2208 else
2209 Local_Errors := True;
2210 Report_Error
2211 ("compilation of ",
2212 Get_Name_String (Source.Path_Name),
2213 " failed");
2214 end if;
2215 end Compile;
2216
2217 --------------------------------
2218 -- Compile_Individual_Sources --
2219 --------------------------------
2220
2221 procedure Compile_Individual_Sources is
aa720a54
AC		 2222 Data : Project_Data := Projects.Table (Main_Project);
2223 Source_Id : Other_Source_Id;
2224 Source : Other_Source;
2225 Source_Name : Name_Id;
9f4fd324
AC		 2226 Project_Name : String := Get_Name_String (Data.Name);
2227 Dummy : Boolean := False;
aa720a54 2228
9f4fd324 2229 Ada_Is_A_Language : constant Boolean := Data.Languages (Lang_Ada);
aa720a54 2230
9f4fd324
AC		 2231 begin
2232 Ada_Mains.Init;
9f4fd324 2233 To_Mixed (Project_Name);
9f4fd324
AC		 2234 Compile_Only := True;
2235
2236 Get_Imported_Directories (Main_Project, Data);
2237 Projects.Table (Main_Project) := Data;
2238
5453d5bd
AC		 2239 -- Compilation will occur in the object directory
2240
2241 Change_Dir (Get_Name_String (Data.Object_Directory));
2242
0da2c8ac 2243 if not Data.Other_Sources_Present then
9f4fd324
AC		 2244 if Ada_Is_A_Language then
2245 Mains.Reset;
2246
2247 loop
2248 declare
2249 Main : constant String := Mains.Next_Main;
2250 begin
2251 exit when Main'Length = 0;
2252 Ada_Mains.Increment_Last;
2253 Ada_Mains.Table (Ada_Mains.Last) := new String'(Main);
2254 end;
2255 end loop;
2256
2257 else
2258 Osint.Fail
2259 ("project ", Project_Name, " contains no source");
2260 end if;
2261
2262 else
2263 Mains.Reset;
2264
2265 loop
2266 declare
2267 Main : constant String := Mains.Next_Main;
2268 begin
2269 Name_Len := Main'Length;
2270 exit when Name_Len = 0;
2271 Name_Buffer (1 .. Name_Len) := Main;
2272 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2273 Source_Name := Name_Find;
2274
2275 if not Sources_Compiled.Get (Source_Name) then
2276 Sources_Compiled.Set (Source_Name, True);
9f4fd324
AC		 2277 Source_Id := Data.First_Other_Source;
2278
2279 while Source_Id /= No_Other_Source loop
2280 Source := Other_Sources.Table (Source_Id);
2281 exit when Source.File_Name = Source_Name;
2282 Source_Id := Source.Next;
2283 end loop;
2284
2285 if Source_Id = No_Other_Source then
2286 if Ada_Is_A_Language then
2287 Ada_Mains.Increment_Last;
0da2c8ac 2288 Ada_Mains.Table (Ada_Mains.Last) := new String'(Main);
9f4fd324
AC		 2289
2290 else
2291 Report_Error
2292 (Main,
2293 " is not a valid source of project ",
2294 Project_Name);
2295 end if;
2296
2297 else
2298 Compile (Source_Id, Data, Dummy);
2299 end if;
2300 end if;
2301 end;
2302 end loop;
2303 end if;
2304
2305 if Ada_Mains.Last > 0 then
aa720a54 2306
0da2c8ac 2307 -- Invoke gnatmake for all Ada sources
9f4fd324
AC		 2308
2309 Last_Argument := 0;
9f4fd324
AC		 2310 Add_Argument (Dash_u, True);
2311
2312 for Index in 1 .. Ada_Mains.Last loop
2313 Add_Argument (Ada_Mains.Table (Index), True);
2314 end loop;
2315
2316 Compile_Link_With_Gnatmake (Mains_Specified => False);
2317 end if;
2318 end Compile_Individual_Sources;
2319
2320 --------------------------------
2321 -- Compile_Link_With_Gnatmake --
2322 --------------------------------
2323
2324 procedure Compile_Link_With_Gnatmake (Mains_Specified : Boolean) is
aa720a54 2325 Data : constant Project_Data := Projects.Table (Main_Project);
9f4fd324 2326 Success : Boolean;
aa720a54 2327
9f4fd324
AC		 2328 begin
2329 -- Array Arguments may already contain some arguments, so we don't
2330 -- set Last_Argument to 0.
2331
2332 -- Get the gnatmake to invoke
2333
2334 Get_Compiler (Lang_Ada);
2335
2336 -- Specify the project file
2337
2338 Add_Argument (Dash_P, True);
2339 Add_Argument (Get_Name_String (Data.Path_Name), True);
2340
15ce9ca2
AC		 2341 -- Add the -X switches, if any
2342
2343 for Index in 1 .. X_Switches.Last loop
2344 Add_Argument (X_Switches.Table (Index), True);
2345 end loop;
2346
9f4fd324
AC		 2347 -- If Mains_Specified is True, find the mains in package Mains
2348
2349 if Mains_Specified then
2350 Mains.Reset;
2351
2352 loop
2353 declare
2354 Main : constant String := Mains.Next_Main;
2355 begin
2356 exit when Main'Length = 0;
2357 Add_Argument (Main, True);
2358 end;
2359 end loop;
2360 end if;
2361
2362 -- Specify output file name, if any was specified on the command line
2363
2364 if Output_File_Name /= null then
2365 Add_Argument (Dash_o, True);
2366 Add_Argument (Output_File_Name, True);
2367 end if;
2368
0da2c8ac 2369 -- Transmit some switches to gnatmake
9f4fd324
AC		 2370
2371 -- -c
2372
2373 if Compile_Only then
2374 Add_Argument (Dash_c, True);
2375 end if;
2376
2377 -- -k
2378
2379 if Keep_Going then
2380 Add_Argument (Dash_k, True);
2381 end if;
2382
2383 -- -f
2384
2385 if Force_Compilations then
2386 Add_Argument (Dash_f, True);
2387 end if;
2388
2389 -- -v
2390
2391 if Verbose_Mode then
2392 Add_Argument (Dash_v, True);
2393 end if;
2394
2395 -- -q
2396
2397 if Quiet_Output then
2398 Add_Argument (Dash_q, True);
2399 end if;
2400
2401 -- -vP1 and -vP2
2402
2403 case Current_Verbosity is
2404 when Default =>
2405 null;
2406
2407 when Medium =>
2408 Add_Argument (Dash_vP1, True);
2409
2410 when High =>
2411 Add_Argument (Dash_vP2, True);
2412 end case;
2413
2414 -- If there are compiling options for Ada, transmit them to gnatmake
2415
2416 if Comp_Opts.Last (Options (Lang_Ada)) /= 0 then
2417 Add_Argument (Dash_cargs, True);
2418
2419 for Arg in 1 .. Comp_Opts.Last (Options (Lang_Ada)) loop
2420 Add_Argument (Options (Lang_Ada).Table (Arg), True);
2421 end loop;
2422 end if;
2423
2424 if not Compile_Only then
0da2c8ac 2425
246d2ceb 2426 -- Linking options
9f4fd324
AC		 2427
2428 if Linker_Options.Last /= 0 then
2429 Add_Argument (Dash_largs, True);
9f4fd324
AC		 2430 else
2431 Add_Argument (Dash_largs, Verbose_Mode);
2432 end if;
2433
2434 -- Add the archives
2435
2436 Add_Archives (For_Gnatmake => True);
246d2ceb
AC		 2437
2438 -- If there are linking options from the command line,
2439 -- transmit them to gnatmake.
2440
2441 for Arg in 1 .. Linker_Options.Last loop
2442 Add_Argument (Linker_Options.Table (Arg), True);
2443 end loop;
9f4fd324
AC		 2444 end if;
2445
2446 -- And invoke gnatmake
2447
2448 Display_Command
2449 (Compiler_Names (Lang_Ada).all, Compiler_Paths (Lang_Ada));
2450
2451 Spawn
2452 (Compiler_Paths (Lang_Ada).all,
2453 Arguments (1 .. Last_Argument),
2454 Success);
2455
2456 -- Report an error if call to gnatmake failed
2457
2458 if not Success then
2459 Report_Error
2460 ("invocation of ", Compiler_Names (Lang_Ada).all, " failed");
2461 end if;
2462
2463 end Compile_Link_With_Gnatmake;
2464
2465 ---------------------
2466 -- Compile_Sources --
2467 ---------------------
2468
2469 procedure Compile_Sources is
2470 Data : Project_Data;
2471 Source_Id : Other_Source_Id;
2472 Source : Other_Source;
2473
2474 Local_Errors : Boolean := False;
aa720a54
AC		 2475 -- Set to True when there is a compilation error. Used only when
2476 -- Keep_Going is True, to inhibit the building of the archive.
9f4fd324
AC		 2477
2478 Need_To_Compile : Boolean;
2479 -- Set to True when a source needs to be compiled/recompiled.
2480
2481 Need_To_Rebuild_Archive : Boolean := Force_Compilations;
2482 -- True when the archive needs to be built/rebuilt unconditionally
2483
2484 begin
0da2c8ac 2485 -- Loop through project files
9f4fd324
AC		 2486
2487 for Project in 1 .. Projects.Last loop
2488 Local_Errors := False;
2489 Data := Projects.Table (Project);
2490
cc335f43
AC		 2491 -- Nothing to do when no sources of language other than Ada
2492
0da2c8ac 2493 if (not Data.Virtual) and then Data.Other_Sources_Present then
aa720a54 2494
9f4fd324
AC		 2495 -- If the imported directory switches are unknown, compute them
2496
2497 if not Data.Include_Data_Set then
2498 Get_Imported_Directories (Project, Data);
2499 Data.Include_Data_Set := True;
2500 Projects.Table (Project) := Data;
2501 end if;
2502
cc335f43 2503 Need_To_Rebuild_Archive := Force_Compilations;
9f4fd324 2504
cc335f43 2505 -- Compilation will occur in the object directory
9f4fd324 2506
cc335f43 2507 Change_Dir (Get_Name_String (Data.Object_Directory));
9f4fd324 2508
cc335f43 2509 Source_Id := Data.First_Other_Source;
9f4fd324 2510
cc335f43 2511 -- Process each source one by one
9f4fd324 2512
cc335f43
AC		 2513 while Source_Id /= No_Other_Source loop
2514 Source := Other_Sources.Table (Source_Id);
2515 Need_To_Compile := Force_Compilations;
9f4fd324 2516
cc335f43 2517 -- Check if compilation is needed
9f4fd324 2518
cc335f43
AC		 2519 if not Need_To_Compile then
2520 Check_Compilation_Needed (Source, Need_To_Compile);
2521 end if;
9f4fd324 2522
cc335f43 2523 -- Proceed, if compilation is needed
9f4fd324 2524
cc335f43 2525 if Need_To_Compile then
aa720a54 2526
cc335f43
AC		 2527 -- If a source is compiled/recompiled, of course the
2528 -- archive will need to be built/rebuilt.
9f4fd324 2529
cc335f43
AC		 2530 Need_To_Rebuild_Archive := True;
2531 Compile (Source_Id, Data, Local_Errors);
2532 end if;
9f4fd324 2533
cc335f43 2534 -- Next source, if any
9f4fd324 2535
cc335f43
AC		 2536 Source_Id := Source.Next;
2537 end loop;
9f4fd324 2538
0da2c8ac
AC		 2539 if Need_To_Rebuild_Archive and then (not Data.Library) then
2540 Need_To_Rebuild_Global_Archive := True;
2541 end if;
2542
cc335f43
AC		 2543 -- If there was no compilation error, build/rebuild the archive
2544 -- if necessary.
9f4fd324 2545
0da2c8ac
AC		 2546 if not Local_Errors
2547 and then Data.Library
2548 and then not Data.Languages (Lang_Ada)
2549 then
2550 Build_Library (Project, Need_To_Rebuild_Archive);
9f4fd324
AC		 2551 end if;
2552 end if;
2553 end loop;
2554 end Compile_Sources;
2555
2556 ---------------
2557 -- Copyright --
2558 ---------------
2559
2560 procedure Copyright is
2561 begin
2562 -- Only output the Copyright notice once
2563
2564 if not Copyright_Output then
2565 Copyright_Output := True;
2566 Write_Eol;
2567 Write_Str ("GPRMAKE ");
2568 Write_Str (Gnatvsn.Gnat_Version_String);
2569 Write_Str (" Copyright 2004 Free Software Foundation, Inc.");
2570 Write_Eol;
2571 end if;
2572 end Copyright;
2573
2574 ------------------------------------
2575 -- Create_Archive_Dependency_File --
2576 ------------------------------------
2577
2578 procedure Create_Archive_Dependency_File
aa720a54
AC		 2579 (Name : String;
2580 First_Source : Other_Source_Id)
9f4fd324
AC		 2581 is
2582 Source_Id : Other_Source_Id := First_Source;
2583 Source : Other_Source;
aa720a54 2584 Dep_File : Ada.Text_IO.File_Type;
9f4fd324
AC		 2585 use Ada.Text_IO;
2586
2587 begin
0da2c8ac
AC		 2588 -- Create the file in Append mode, to avoid automatic insertion of
2589 -- an end of line if file is empty.
2590
2591 Create (Dep_File, Append_File, Name);
9f4fd324
AC		 2592
2593 while Source_Id /= No_Other_Source loop
2594 Source := Other_Sources.Table (Source_Id);
2595 Put_Line (Dep_File, Get_Name_String (Source.Object_Name));
2596 Put_Line (Dep_File, String (Source.Object_TS));
2597 Source_Id := Source.Next;
2598 end loop;
2599
2600 Close (Dep_File);
2601
2602 exception
2603 when others =>
2604 if Is_Open (Dep_File) then
2605 Close (Dep_File);
2606 end if;
2607 end Create_Archive_Dependency_File;
2608
0da2c8ac
AC		 2609 -------------------------------------------
2610 -- Create_Global_Archive_Dependency_File --
2611 -------------------------------------------
2612
2613 procedure Create_Global_Archive_Dependency_File (Name : String) is
2614 Source_Id : Other_Source_Id;
2615 Source : Other_Source;
2616 Dep_File : Ada.Text_IO.File_Type;
2617
2618 use Ada.Text_IO;
2619
2620 begin
2621 -- Create the file in Append mode, to avoid automatic insertion of
2622 -- an end of line if file is empty.
2623
2624 Create (Dep_File, Append_File, Name);
2625
2626 -- Get all the object files of non-Ada sources in non-library projects
2627
2628 for Project in 1 .. Projects.Last loop
2629 if not Projects.Table (Project).Library then
2630 Source_Id := Projects.Table (Project).First_Other_Source;
2631
2632 while Source_Id /= No_Other_Source loop
2633 Source := Other_Sources.Table (Source_Id);
2634
2635 -- Put only those object files that are in the global archive
2636
2637 if Is_Included_In_Global_Archive
2638 (Source.Object_Name, Project)
2639 then
2640 Put_Line (Dep_File, Get_Name_String (Source.Object_Path));
2641 Put_Line (Dep_File, String (Source.Object_TS));
2642 end if;
2643
2644 Source_Id := Source.Next;
2645 end loop;
2646 end if;
2647 end loop;
2648
2649 Close (Dep_File);
2650
2651 exception
2652 when others =>
2653 if Is_Open (Dep_File) then
2654 Close (Dep_File);
2655 end if;
2656 end Create_Global_Archive_Dependency_File;
2657
9f4fd324
AC		 2658 ---------------------
2659 -- Display_Command --
2660 ---------------------
2661
5453d5bd
AC		 2662 procedure Display_Command
2663 (Name : String;
2664 Path : String_Access;
2665 CPATH : String_Access := null)
2666 is
9f4fd324
AC		 2667 begin
2668 -- Only display the command in Verbose Mode (-v) or when
2669 -- not in Quiet Output (no -q).
2670
2671 if Verbose_Mode or (not Quiet_Output) then
0da2c8ac 2672
9f4fd324
AC		 2673 -- In Verbose Mode output the full path of the spawned process
2674
2675 if Verbose_Mode then
5453d5bd
AC		 2676 if CPATH /= null then
2677 Write_Str ("CPATH = ");
2678 Write_Line (CPATH.all);
2679 end if;
2680
9f4fd324
AC		 2681 Write_Str (Path.all);
2682
2683 else
2684 Write_Str (Name);
2685 end if;
2686
2687 -- Display only the arguments for which the display flag is set
2688 -- (in Verbose Mode, the display flag is set for all arguments)
2689
2690 for Arg in 1 .. Last_Argument loop
2691 if Arguments_Displayed (Arg) then
2692 Write_Char (' ');
2693 Write_Str (Arguments (Arg).all);
2694 end if;
2695 end loop;
2696
2697 Write_Eol;
2698 end if;
2699 end Display_Command;
2700
2701 ------------------
2702 -- Get_Compiler --
2703 ------------------
2704
2705 procedure Get_Compiler (For_Language : Programming_Language) is
2706 Data : constant Project_Data := Projects.Table (Main_Project);
2707
2708 Ide : constant Package_Id :=
2709 Value_Of (Name_Ide, In_Packages => Data.Decl.Packages);
2710 -- The id of the package IDE in the project file
2711
2712 Compiler : constant Variable_Value :=
aa720a54
AC		 2713 Value_Of
2714 (Name => Lang_Name_Ids (For_Language),
2715 Index => 0,
2716 Attribute_Or_Array_Name => Name_Compiler_Command,
2717 In_Package => Ide);
2718 -- The value of Compiler_Command ("language") in package IDE, if defined
9f4fd324
AC		 2719
2720 begin
2721 -- No need to do it again if the compiler is known for this language
2722
2723 if Compiler_Names (For_Language) = null then
aa720a54 2724
9f4fd324
AC		 2725 -- If compiler command is not defined for this language in package
2726 -- IDE, use the default compiler for this language.
2727
2728 if Compiler = Nil_Variable_Value then
2729 Compiler_Names (For_Language) :=
2730 Default_Compiler_Names (For_Language);
2731
2732 else
2733 Compiler_Names (For_Language) :=
2734 new String'(Get_Name_String (Compiler.Value));
2735 end if;
2736
aa720a54 2737 -- Check we have a GCC compiler (name ends with "gcc" or "g++")
9f4fd324
AC		 2738
2739 declare
2740 Comp_Name : constant String := Compiler_Names (For_Language).all;
2741 Last3 : String (1 .. 3);
2742 begin
2743 if Comp_Name'Length >= 3 then
2744 Last3 := Comp_Name (Comp_Name'Last - 2 .. Comp_Name'Last);
2745 Compiler_Is_Gcc (For_Language) :=
2746 (Last3 = "gcc") or (Last3 = "g++");
9f4fd324
AC		 2747 else
2748 Compiler_Is_Gcc (For_Language) := False;
2749 end if;
2750 end;
2751
2752 -- Locate the compiler on the path
2753
2754 Compiler_Paths (For_Language) :=
2755 Locate_Exec_On_Path (Compiler_Names (For_Language).all);
2756
2757 -- Fail if compiler cannot be found
2758
2759 if Compiler_Paths (For_Language) = null then
2760 if For_Language = Lang_Ada then
2761 Osint.Fail
2762 ("unable to locate """,
2763 Compiler_Names (For_Language).all,
2764 """");
2765
2766 else
2767 Osint.Fail
2768 ("unable to locate " & Lang_Display_Names (For_Language).all,
2769 " compiler """, Compiler_Names (For_Language).all & '"');
2770 end if;
2771 end if;
2772 end if;
2773 end Get_Compiler;
2774
2775 ------------------------------
2776 -- Get_Imported_Directories --
2777 ------------------------------
2778
2779 procedure Get_Imported_Directories
2780 (Project : Project_Id;
2781 Data : in out Project_Data)
2782 is
2783 Imported_Projects : Project_List := Data.Imported_Projects;
aa720a54 2784
9f4fd324
AC		 2785 Path_Length : Natural := 0;
2786 Position : Natural := 0;
2787
2788 procedure Add (Source_Dirs : String_List_Id);
2789 -- Add a list of source directories
2790
2791 procedure Recursive_Get_Dirs (Prj : Project_Id);
2792 -- Recursive procedure to get the source directories of this project
2793 -- file and of the project files it imports, in the correct order.
2794
2795 ---------
2796 -- Add --
2797 ---------
2798
2799 procedure Add (Source_Dirs : String_List_Id) is
2800 Element_Id : String_List_Id := Source_Dirs;
2801 Element : String_Element;
2802 Add_Arg : Boolean := True;
0da2c8ac 2803
9f4fd324 2804 begin
0da2c8ac 2805 -- Add each source directory path name, preceded by "-I" to Arguments
9f4fd324
AC		 2806
2807 while Element_Id /= Nil_String loop
2808 Element := String_Elements.Table (Element_Id);
2809
2810 if Element.Value /= No_Name then
2811 Get_Name_String (Element.Value);
2812
2813 if Name_Len > 0 then
2814 declare
2815 Arg : constant String :=
2816 "-I" & Name_Buffer (1 .. Name_Len);
2817 begin
2818 -- Check if directory is already in the list.
2819 -- If it is, no need to put it again.
2820
2821 for Index in 1 .. Last_Argument loop
2822 if Arguments (Index).all = Arg then
2823 Add_Arg := False;
2824 exit;
2825 end if;
2826 end loop;
2827
2828 if Add_Arg then
2829 if Path_Length /= 0 then
2830 Path_Length := Path_Length + 1;
2831 end if;
2832
2833 Path_Length := Path_Length + Name_Len;
2834
2835 Add_Argument (Arg, True);
2836 end if;
2837 end;
2838 end if;
2839 end if;
2840
2841 Element_Id := Element.Next;
2842 end loop;
2843 end Add;
2844
2845 ------------------------
2846 -- Recursive_Get_Dirs --
2847 ------------------------
2848
2849 procedure Recursive_Get_Dirs (Prj : Project_Id) is
aa720a54 2850 Data : Project_Data;
9f4fd324 2851 Imported : Project_List;
aa720a54 2852
9f4fd324
AC		 2853 begin
2854 -- Nothing to do if project is undefined
2855
2856 if Prj /= No_Project then
2857 Data := Projects.Table (Prj);
2858
2859 -- Nothing to do if project has already been processed
2860
2861 if not Data.Seen then
aa720a54 2862
9f4fd324
AC		 2863 -- Mark the project as processed, to avoid multiple processing
2864 -- of the same project.
2865
2866 Projects.Table (Prj).Seen := True;
2867
2868 -- Add the source directories of this project
2869
2870 if not Data.Virtual then
2871 Add (Data.Source_Dirs);
2872 end if;
2873
2874 Recursive_Get_Dirs (Data.Extends);
2875
2876 Imported := Data.Imported_Projects;
2877
2878 -- Call itself for all imported projects, if any
2879
2880 while Imported /= Empty_Project_List loop
2881 Recursive_Get_Dirs (Project_Lists.Table (Imported).Project);
2882 Imported := Project_Lists.Table (Imported).Next;
2883 end loop;
2884 end if;
2885 end if;
2886 end Recursive_Get_Dirs;
2887
0da2c8ac
AC		 2888 -- Start of processing for Get_Imported_Directories
2889
9f4fd324
AC		 2890 begin
2891 -- First, mark all project as not processed
2892
2893 for J in 1 .. Projects.Last loop
2894 Projects.Table (J).Seen := False;
2895 end loop;
2896
2897 -- Empty Arguments
2898
2899 Last_Argument := 0;
2900
aa720a54 2901 -- Process this project individually, project data are already known
9f4fd324
AC		 2902
2903 Projects.Table (Project).Seen := True;
2904
2905 Add (Data.Source_Dirs);
2906
2907 Recursive_Get_Dirs (Data.Extends);
2908
2909 while Imported_Projects /= Empty_Project_List loop
2910 Recursive_Get_Dirs (Project_Lists.Table (Imported_Projects).Project);
2911 Imported_Projects := Project_Lists.Table (Imported_Projects).Next;
2912 end loop;
2913
2914 Data.Imported_Directories_Switches :=
2915 new Argument_List'(Arguments (1 .. Last_Argument));
2916
2917 -- Create the Include_Path, from the Arguments
2918
2919 Data.Include_Path := new String (1 .. Path_Length);
2920 Data.Include_Path (1 .. Arguments (1)'Length - 2) :=
2921 Arguments (1)(Arguments (1)'First + 2 .. Arguments (1)'Last);
2922 Position := Arguments (1)'Length - 2;
2923
2924 for Arg in 2 .. Last_Argument loop
2925 Position := Position + 1;
2926 Data.Include_Path (Position) := Path_Separator;
2927 Data.Include_Path
2928 (Position + 1 .. Position + Arguments (Arg)'Length - 2) :=
2929 Arguments (Arg)(Arguments (Arg)'First + 2 .. Arguments (Arg)'Last);
2930 Position := Position + Arguments (Arg)'Length - 2;
2931 end loop;
2932
2933 Last_Argument := 0;
2934 end Get_Imported_Directories;
2935
2936 -------------
2937 -- Gprmake --
2938 -------------
2939
2940 procedure Gprmake is
2941 begin
2942 Initialize;
2943
2944 if Verbose_Mode then
2945 Write_Eol;
2946 Write_Str ("Parsing Project File """);
2947 Write_Str (Project_File_Name.all);
2948 Write_Str (""".");
2949 Write_Eol;
2950 end if;
2951
0da2c8ac 2952 -- Parse and process project files for other languages (not for Ada)
9f4fd324
AC		 2953
2954 Prj.Pars.Parse
2955 (Project => Main_Project,
2956 Project_File_Name => Project_File_Name.all,
2957 Packages_To_Check => Packages_To_Check,
2958 Process_Languages => Other_Languages);
2959
2960 -- Fail if parsing/processing was unsuccessful
2961
2962 if Main_Project = No_Project then
2963 Osint.Fail ("""", Project_File_Name.all, """ processing failed");
2964 end if;
2965
2966 if Verbose_Mode then
2967 Write_Eol;
2968 Write_Str ("Parsing of Project File """);
2969 Write_Str (Project_File_Name.all);
2970 Write_Str (""" is finished.");
2971 Write_Eol;
2972 end if;
2973
2974 -- If -f was specified, we will certainly need to link (except when
2975 -- -u or -c were specified, of course).
2976
2977 Need_To_Relink := Force_Compilations;
2978
2979 if Unique_Compile then
2980 if Mains.Number_Of_Mains = 0 then
2981 Osint.Fail
2982 ("No source specified to compile in 'unique compile' mode");
9f4fd324
AC		 2983 else
2984 Compile_Individual_Sources;
2985 Report_Total_Errors ("compilation");
2986 end if;
2987
2988 else
0da2c8ac
AC		 2989 -- First compile sources and build archives for library project,
2990 -- if necessary.
9f4fd324
AC		 2991
2992 Compile_Sources;
2993
2994 -- When Keep_Going is True, if we had some errors, fail now,
2995 -- reporting the number of compilation errors.
2996 -- Do not attempt to link.
2997
2998 Report_Total_Errors ("compilation");
2999
3000 -- If -c was not specified, link the executables, if there are any.
3001
3002 if not Compile_Only then
0da2c8ac 3003 Build_Global_Archive;
9f4fd324
AC		 3004 Check_For_C_Plus_Plus;
3005 Link_Executables;
3006 end if;
3007
3008 -- When Keep_Going is True, if we had some errors, fail, reporting
3009 -- the number of linking errors.
3010
3011 Report_Total_Errors ("linking");
3012 end if;
3013 end Gprmake;
3014
3015 ----------------
3016 -- Initialize --
3017 ----------------
3018
3019 procedure Initialize is
9f4fd324
AC		 3020 begin
3021 -- Do some necessary package initializations
3022
3023 Csets.Initialize;
3024 Namet.Initialize;
3025 Snames.Initialize;
3026 Prj.Initialize;
3027 Mains.Delete;
3028
3029 -- Set Name_Ide and Name_Compiler_Command
3030
3031 Name_Len := 0;
3032 Add_Str_To_Name_Buffer ("ide");
3033 Name_Ide := Name_Find;
3034
3035 Name_Len := 0;
3036 Add_Str_To_Name_Buffer ("compiler_command");
3037 Name_Compiler_Command := Name_Find;
3038
15ce9ca2
AC		 3039 -- Make sure the -X switch table is empty
3040
3041 X_Switches.Set_Last (0);
3042
9f4fd324
AC		 3043 -- Get the command line arguments
3044
5453d5bd 3045 Scan_Args : for Next_Arg in 1 .. Argument_Count loop
9f4fd324 3046 Scan_Arg (Argument (Next_Arg));
9f4fd324
AC		 3047 end loop Scan_Args;
3048
3049 -- Fail if command line ended with "-P"
3050
3051 if Project_File_Name_Expected then
3052 Osint.Fail ("project file name missing after -P");
3053
3054 -- Or if it ended with "-o"
3055
3056 elsif Output_File_Name_Expected then
3057 Osint.Fail ("output file name missing after -o");
3058 end if;
3059
3060 -- If no project file was specified, display the usage and fail
3061
3062 if Project_File_Name = null then
3063 Usage;
3064 Exit_Program (E_Success);
3065 end if;
3066
3067 -- To be able of finding libgnat.a in MLib.Tgt, we need to have the
3068 -- default search dirs established in Osint.
3069
3070 Osint.Add_Default_Search_Dirs;
3071 end Initialize;
3072
0da2c8ac
AC		 3073 -----------------------------------
3074 -- Is_Included_In_Global_Archive --
3075 -----------------------------------
3076
3077 function Is_Included_In_Global_Archive
3078 (Object_Name : Name_Id;
3079 Project : Project_Id) return Boolean
3080 is
3081 Data : Project_Data := Projects.Table (Project);
3082 Source : Other_Source_Id;
3083
3084 begin
3085 while Data.Extended_By /= No_Project loop
3086 Data := Projects.Table (Data.Extended_By);
3087 Source := Data.First_Other_Source;
3088
3089 while Source /= No_Other_Source loop
3090 if Other_Sources.Table (Source).Object_Name = Object_Name then
3091 return False;
3092 else
3093 Source := Other_Sources.Table (Source).Next;
3094 end if;
3095 end loop;
3096 end loop;
3097
3098 return True;
3099 end Is_Included_In_Global_Archive;
3100
9f4fd324
AC		 3101 ----------------------
3102 -- Link_Executables --
3103 ----------------------
3104
3105 procedure Link_Executables is
3106 Data : constant Project_Data := Projects.Table (Main_Project);
3107
3108 Mains_Specified : constant Boolean := Mains.Number_Of_Mains /= 0;
3109 -- True if main sources were specified on the command line
3110
3111 Object_Dir : constant String := Get_Name_String (Data.Object_Directory);
3112 -- Path of the object directory of the main project
3113
3114 Source_Id : Other_Source_Id;
3115 Source : Other_Source;
3116 Success : Boolean;
3117
3118 Linker_Name : String_Access;
3119 Linker_Path : String_Access;
3120 -- The linker name and path, when linking is not done by gnatlink
3121
3122 Link_Done : Boolean := False;
3123 -- Set to True when the linker is invoked directly (not through
3124 -- gnatmake) to be able to report if mains were up to date at the end
3125 -- of execution.
3126
3127 procedure Add_C_Plus_Plus_Link_For_Gnatmake;
3128 -- Add the --LINK= switch for gnatlink, depending on the C++ compiler
3129
0da2c8ac
AC		 3130 procedure Check_Time_Stamps (Exec_Time_Stamp : Time_Stamp_Type);
3131 -- Check if there is an archive that is more recent than the executable
3132 -- to decide if we need to relink.
3133
9f4fd324
AC		 3134 procedure Choose_C_Plus_Plus_Link_Process;
3135 -- If the C++ compiler is not g++, create the correct script to link
3136
0da2c8ac
AC		 3137 procedure Link_Foreign
3138 (Main : String;
3139 Main_Id : Name_Id;
3140 Source : Other_Source);
3141 -- Link a non-Ada main, when there is no Ada code
3142
9f4fd324
AC		 3143 ---------------------------------------
3144 -- Add_C_Plus_Plus_Link_For_Gnatmake --
3145 ---------------------------------------
3146
3147 procedure Add_C_Plus_Plus_Link_For_Gnatmake is
3148 begin
3149 if Compiler_Is_Gcc (Lang_C_Plus_Plus) then
3150 Add_Argument
3151 ("--LINK=" & Compiler_Names (Lang_C_Plus_Plus).all,
3152 Verbose_Mode);
3153
3154 else
3155 Add_Argument
3156 ("--LINK=" &
3157 Object_Dir & Directory_Separator &
3158 Cpp_Linker,
3159 Verbose_Mode);
3160 end if;
3161 end Add_C_Plus_Plus_Link_For_Gnatmake;
3162
0da2c8ac
AC		 3163 -----------------------
3164 -- Check_Time_Stamps --
3165 -----------------------
3166
3167 procedure Check_Time_Stamps (Exec_Time_Stamp : Time_Stamp_Type) is
3168 Prj_Data : Project_Data;
3169
3170 begin
3171 for Prj in 1 .. Projects.Last loop
3172 Prj_Data := Projects.Table (Prj);
3173
3174 -- There is an archive only in project
3175 -- files with sources other than Ada
3176 -- sources.
3177
3178 if Data.Other_Sources_Present then
3179 declare
3180 Archive_Path : constant String :=
3181 Get_Name_String
3182 (Prj_Data.Object_Directory) &
3183 Directory_Separator &
3184 "lib" &
3185 Get_Name_String (Prj_Data.Name) &
3186 '.' & Archive_Ext;
3187 Archive_TS : Time_Stamp_Type;
3188 begin
3189 Name_Len := 0;
3190 Add_Str_To_Name_Buffer
3191 (Archive_Path);
3192 Archive_TS := File_Stamp (Name_Find);
3193
3194 -- If the archive is later than the
3195 -- executable, we need to relink.
3196
3197 if Archive_TS /= Empty_Time_Stamp
3198 and then
3199 Exec_Time_Stamp < Archive_TS
3200 then
3201 Need_To_Relink := True;
3202
3203 if Verbose_Mode then
3204 Write_Str (" -> ");
3205 Write_Str (Archive_Path);
3206 Write_Str (" has time stamp ");
3207 Write_Str ("later than ");
3208 Write_Line ("executable");
3209 end if;
3210
3211 exit;
3212 end if;
3213 end;
3214 end if;
3215 end loop;
3216 end Check_Time_Stamps;
3217
9f4fd324
AC		 3218 -------------------------------------
3219 -- Choose_C_Plus_Plus_Link_Process --
3220 -------------------------------------
3221
3222 procedure Choose_C_Plus_Plus_Link_Process is
3223 begin
3224 if Compiler_Names (Lang_C_Plus_Plus) = null then
3225 Get_Compiler (Lang_C_Plus_Plus);
3226 end if;
3227
3228 if not Compiler_Is_Gcc (Lang_C_Plus_Plus) then
3229 Change_Dir (Object_Dir);
3230
3231 declare
3232 procedure Set_Executable (Name : System.Address);
3233 pragma Import
3234 (C, Set_Executable, "__gnat_set_executable");
3235
3236 Name : constant String := Cpp_Linker & ASCII.NUL;
3237
3238 File : Ada.Text_IO.File_Type;
3239 use Ada.Text_IO;
aa720a54 3240
9f4fd324
AC		 3241 begin
3242 Create (File, Out_File, Cpp_Linker);
3243
3244 Put_Line (File, "#!/bin/sh");
3245
3246 Put_Line (File, "LIBGCC=`gcc -print-libgcc-file-name`");
3247 Put_Line
3248 (File,
3249 Compiler_Names (Lang_C_Plus_Plus).all &
3250 " $* ${LIBGCC}");
3251
3252 Close (File);
3253 Set_Executable (Name (Name'First)'Address);
3254 end;
3255 end if;
3256 end Choose_C_Plus_Plus_Link_Process;
3257
0da2c8ac
AC		 3258 ------------------
3259 -- Link_Foreign --
3260 ------------------
3261
3262 procedure Link_Foreign
3263 (Main : String;
3264 Main_Id : Name_Id;
3265 Source : Other_Source)
3266 is
3267 Executable_Name : constant String :=
3268 Get_Name_String
3269 (Executable_Of
3270 (Project => Main_Project,
3271 Main => Main_Id,
3272 Index => 0,
3273 Ada_Main => False));
3274 -- File name of the executable
3275
3276 Executable_Path : constant String :=
3277 Get_Name_String
3278 (Data.Exec_Directory) &
3279 Directory_Separator &
3280 Executable_Name;
3281 -- Path name of the executable
3282
3283 Exec_Time_Stamp : Time_Stamp_Type;
3284
3285 begin
3286 -- Now, check if the executable is up to date. It is considered
3287 -- up to date if its time stamp is not earlier that the time stamp
3288 -- of any archive. Only do that if we don't know if we need to link.
3289
3290 if not Need_To_Relink then
3291
3292 -- Get the time stamp of the executable
3293
3294 Name_Len := 0;
3295 Add_Str_To_Name_Buffer (Executable_Path);
3296 Exec_Time_Stamp := File_Stamp (Name_Find);
3297
3298 if Verbose_Mode then
3299 Write_Str (" Checking executable ");
3300 Write_Line (Executable_Name);
3301 end if;
3302
3303 -- If executable does not exist, we need to link
3304
3305 if Exec_Time_Stamp = Empty_Time_Stamp then
3306 Need_To_Relink := True;
3307
3308 if Verbose_Mode then
3309 Write_Line (" -> not found");
3310 end if;
3311
3312 -- Otherwise, get the time stamps of each archive. If one of
3313 -- them is found later than the executable, we need to relink.
3314
3315 else
3316 Check_Time_Stamps (Exec_Time_Stamp);
3317 end if;
3318
3319 -- If Need_To_Relink is False, we are done
3320
3321 if Verbose_Mode and (not Need_To_Relink) then
3322 Write_Line (" -> up to date");
3323 end if;
3324 end if;
3325
3326 -- Prepare to link
3327
3328 if Need_To_Relink then
3329 Link_Done := True;
3330
3331 Last_Argument := 0;
3332
3333 -- Specify the executable path name
3334
3335 Add_Argument (Dash_o, True);
3336 Add_Argument
3337 (Get_Name_String (Data.Exec_Directory) &
3338 Directory_Separator &
3339 Get_Name_String
3340 (Executable_Of
3341 (Project => Main_Project,
3342 Main => Main_Id,
3343 Index => 0,
3344 Ada_Main => False)),
3345 True);
3346
3347 -- Specify the object file of the main source
3348
3349 Add_Argument
3350 (Object_Dir & Directory_Separator &
3351 Get_Name_String (Source.Object_Name),
3352 True);
3353
246d2ceb
AC		 3354 -- Add all the archives, in a correct order
3355
3356 Add_Archives (For_Gnatmake => False);
3357
0da2c8ac
AC		 3358 -- Add the switches specified in package Linker of
3359 -- the main project.
3360
3361 Add_Switches
3362 (Data => Data,
3363 Proc => Linker,
3364 Language => Source.Language,
3365 File_Name => Main_Id);
3366
3367 -- Add the switches specified in attribute
3368 -- Linker_Options of packages Linker.
3369
3370 if Link_Options_Switches = null then
3371 Link_Options_Switches :=
3372 new Argument_List'
3373 (Linker_Options_Switches (Main_Project));
3374 end if;
3375
3376 Add_Arguments (Link_Options_Switches.all, True);
3377
3378 -- Add the linking options specified on the
3379 -- command line.
3380
3381 for Arg in 1 .. Linker_Options.Last loop
3382 Add_Argument (Linker_Options.Table (Arg), True);
3383 end loop;
3384
0da2c8ac
AC		 3385 -- If there are shared libraries and the run path
3386 -- option is supported, add the run path switch.
3387
3388 if Lib_Path.Last > 0 then
3389 Add_Argument
3390 (Path_Option.all &
3391 String (Lib_Path.Table (1 .. Lib_Path.Last)),
3392 Verbose_Mode);
3393 end if;
3394
3395 -- And invoke the linker
3396
3397 Display_Command (Linker_Name.all, Linker_Path);
3398 Spawn
3399 (Linker_Path.all,
3400 Arguments (1 .. Last_Argument),
3401 Success);
3402
3403 if not Success then
3404 Report_Error ("could not link ", Main);
3405 end if;
3406 end if;
3407 end Link_Foreign;
3408
3409 -- Start of processing of Link_Executables
3410
9f4fd324 3411 begin
aa720a54 3412 -- If no mains specified, get mains from attribute Main, if it exists
9f4fd324
AC		 3413
3414 if not Mains_Specified then
3415 declare
3416 Element_Id : String_List_Id := Data.Mains;
3417 Element : String_Element;
3418
3419 begin
3420 while Element_Id /= Nil_String loop
3421 Element := String_Elements.Table (Element_Id);
3422
3423 if Element.Value /= No_Name then
3424 Mains.Add_Main (Get_Name_String (Element.Value));
3425 end if;
3426
3427 Element_Id := Element.Next;
3428 end loop;
3429 end;
3430 end if;
3431
3432 if Mains.Number_Of_Mains = 0 then
0da2c8ac 3433
9f4fd324
AC		 3434 -- If the attribute Main is an empty list or not specified,
3435 -- there is nothing to do.
3436
3437 if Verbose_Mode then
3438 Write_Line ("No main to link");
3439 end if;
3440 return;
3441 end if;
3442
3443 -- Check if -o was used for several mains
3444
3445 if Output_File_Name /= null and then Mains.Number_Of_Mains > 1 then
3446 Osint.Fail ("cannot specify an executable name for several mains");
3447 end if;
3448
3449 -- Check how we are going to do the link
3450
0da2c8ac
AC		 3451 if not Data.Other_Sources_Present then
3452
9f4fd324
AC		 3453 -- Only Ada sources in the main project, and even maybe not
3454
3455 if not Data.Languages (Lang_Ada) then
0da2c8ac 3456
9f4fd324
AC		 3457 -- Fail if the main project has no source of any language
3458
3459 Osint.Fail
3460 ("project """,
3461 Get_Name_String (Data.Name),
3462 """ has no sources, so no main can be linked");
3463
3464 else
3465 -- Only Ada sources in the main project, call gnatmake directly
3466
3467 Last_Argument := 0;
3468
0da2c8ac 3469 -- Choose correct linker if there is C++ code in other projects
9f4fd324
AC		 3470
3471 if C_Plus_Plus_Is_Used then
3472 Choose_C_Plus_Plus_Link_Process;
3473 Add_Argument (Dash_largs, Verbose_Mode);
3474 Add_C_Plus_Plus_Link_For_Gnatmake;
3475 Add_Argument (Dash_margs, Verbose_Mode);
3476 end if;
3477
3478 Compile_Link_With_Gnatmake (Mains_Specified);
3479 end if;
3480
3481 else
3482 -- There are other language sources. First check if there are also
3483 -- sources in Ada.
3484
3485 if Data.Languages (Lang_Ada) then
0da2c8ac 3486
9f4fd324
AC		 3487 -- There is a mix of Ada and other language sources in the main
3488 -- project. Any main that is not a source of the other languages
3489 -- will be deemed to be an Ada main.
0da2c8ac 3490
9f4fd324
AC		 3491 -- Find the mains of the other languages and the Ada mains.
3492
3493 Mains.Reset;
3494 Ada_Mains.Set_Last (0);
3495 Other_Mains.Set_Last (0);
3496
3497 -- For each main
3498
3499 loop
3500 declare
0da2c8ac 3501 Main : constant String := Mains.Next_Main;
9f4fd324 3502 Main_Id : Name_Id;
0da2c8ac 3503
9f4fd324
AC		 3504 begin
3505 exit when Main'Length = 0;
3506
3507 -- Get the main file name
3508
3509 Name_Len := 0;
3510 Add_Str_To_Name_Buffer (Main);
3511 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3512 Main_Id := Name_Find;
3513 Source_Id := Data.First_Other_Source;
3514
3515 -- Check if it is a source of a language other than Ada
3516
3517 while Source_Id /= No_Other_Source loop
3518 Source := Other_Sources.Table (Source_Id);
3519 exit when Source.File_Name = Main_Id;
3520 Source_Id := Source.Next;
3521 end loop;
3522
3523 -- If it is not, put it in the list of Ada mains
3524
3525 if Source_Id = No_Other_Source then
3526 Ada_Mains.Increment_Last;
3527 Ada_Mains.Table (Ada_Mains.Last) := new String'(Main);
3528
3529 -- Otherwise, put it in the list of other mains
3530
3531 else
3532 Other_Mains.Increment_Last;
3533 Other_Mains.Table (Other_Mains.Last) := Source;
3534 end if;
3535 end;
3536 end loop;
3537
3538 -- If C++ is one of the other language, create the shell script
3539 -- to do the link.
3540
3541 if C_Plus_Plus_Is_Used then
3542 Choose_C_Plus_Plus_Link_Process;
3543 end if;
3544
3545 -- Call gnatmake with the necessary switches for each non-Ada
3546 -- main, if there are some.
3547
3548 for Main in 1 .. Other_Mains.Last loop
3549 declare
3550 Source : constant Other_Source := Other_Mains.Table (Main);
0da2c8ac 3551
9f4fd324
AC		 3552 begin
3553 Last_Argument := 0;
3554
3555 -- Add -o if -o was specified
3556
3557 if Output_File_Name = null then
3558 Add_Argument (Dash_o, True);
3559 Add_Argument
3560 (Get_Name_String
3561 (Executable_Of
3562 (Project => Main_Project,
3563 Main => Other_Mains.Table (Main).File_Name,
aa720a54 3564 Index => 0,
9f4fd324
AC		 3565 Ada_Main => False)),
3566 True);
3567 end if;
3568
3569 -- Call gnatmake with the -B switch
3570
3571 Add_Argument (Dash_B, True);
3572
3573 -- Add to the linking options the object file of the source
3574
3575 Add_Argument (Dash_largs, Verbose_Mode);
3576 Add_Argument
3577 (Get_Name_String (Source.Object_Name), Verbose_Mode);
3578
3579 -- If C++ is one of the language, add the --LINK switch
3580 -- to the linking switches.
3581
3582 if C_Plus_Plus_Is_Used then
3583 Add_C_Plus_Plus_Link_For_Gnatmake;
3584 end if;
3585
3586 -- Add -margs so that the following switches are for
3587 -- gnatmake
3588
3589 Add_Argument (Dash_margs, Verbose_Mode);
3590
3591 -- And link with gnatmake
3592
3593 Compile_Link_With_Gnatmake (Mains_Specified => False);
3594 end;
3595 end loop;
3596
3597 -- If there are also Ada mains, call gnatmake for all these mains
3598
3599 if Ada_Mains.Last /= 0 then
3600 Last_Argument := 0;
3601
3602 -- Put all the Ada mains as the first arguments
3603
3604 for Main in 1 .. Ada_Mains.Last loop
3605 Add_Argument (Ada_Mains.Table (Main).all, True);
3606 end loop;
3607
3608 -- If C++ is one of the languages, add the --LINK switch to
3609 -- the linking switches.
3610
3611 if Data.Languages (Lang_C_Plus_Plus) then
3612 Add_Argument (Dash_largs, Verbose_Mode);
3613 Add_C_Plus_Plus_Link_For_Gnatmake;
3614 Add_Argument (Dash_margs, Verbose_Mode);
3615 end if;
3616
3617 -- And link with gnatmake
3618
3619 Compile_Link_With_Gnatmake (Mains_Specified => False);
3620 end if;
3621
3622 else
3623 -- No Ada source in main project
3624
3625 -- First, get the linker to invoke
3626
3627 if Data.Languages (Lang_C_Plus_Plus) then
3628 Get_Compiler (Lang_C_Plus_Plus);
3629 Linker_Name := Compiler_Names (Lang_C_Plus_Plus);
3630 Linker_Path := Compiler_Paths (Lang_C_Plus_Plus);
3631
3632 else
3633 Get_Compiler (Lang_C);
3634 Linker_Name := Compiler_Names (Lang_C);
3635 Linker_Path := Compiler_Paths (Lang_C);
3636 end if;
3637
3638 Link_Done := False;
3639
3640 Mains.Reset;
3641
3642 -- Get each main, check if it is a source of the main project,
3643 -- and if it is, invoke the linker.
3644
3645 loop
3646 declare
3647 Main : constant String := Mains.Next_Main;
3648 Main_Id : Name_Id;
3649 begin
3650 exit when Main'Length = 0;
3651
3652 -- Get the file name of the main
3653
3654 Name_Len := 0;
3655 Add_Str_To_Name_Buffer (Main);
3656 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3657 Main_Id := Name_Find;
3658 Source_Id := Data.First_Other_Source;
3659
3660 -- Check if it is a source of the main project file
3661
3662 while Source_Id /= No_Other_Source loop
3663 Source := Other_Sources.Table (Source_Id);
3664 exit when Source.File_Name = Main_Id;
3665 Source_Id := Source.Next;
3666 end loop;
3667
3668 -- Report an error if it is not
3669
3670 if Source_Id = No_Other_Source then
3671 Report_Error
3672 (Main, "is not a source of project ",
3673 Get_Name_String (Data.Name));
3674
3675 else
0da2c8ac 3676 Link_Foreign (Main, Main_Id, Source);
9f4fd324
AC		 3677 end if;
3678 end;
3679 end loop;
3680
3681 -- If no linking was done, report it, except in Quiet Output
3682
3683 if (Verbose_Mode or (not Quiet_Output)) and (not Link_Done) then
3684 Osint.Write_Program_Name;
3685
3686 if Mains.Number_Of_Mains = 1 then
0da2c8ac 3687
9f4fd324
AC		 3688 -- If there is only one executable, report its name too
3689
3690 Write_Str (": """);
3691 Mains.Reset;
3692
3693 declare
0da2c8ac 3694 Main : constant String := Mains.Next_Main;
9f4fd324
AC		 3695 Main_Id : Name_Id;
3696 begin
3697 Name_Len := 0;
3698 Add_Str_To_Name_Buffer (Main);
3699 Main_Id := Name_Find;
3700 Write_Str
3701 (Get_Name_String
3702 (Executable_Of
aa720a54
AC		 3703 (Project => Main_Project,
3704 Main => Main_Id,
3705 Index => 0,
3706 Ada_Main => False)));
9f4fd324
AC		 3707 Write_Line (""" up to date");
3708 end;
3709
3710 else
3711 Write_Line (": all executables up to date");
3712 end if;
3713 end if;
3714 end if;
3715 end if;
3716 end Link_Executables;
3717
3718 ------------------
3719 -- Report_Error --
3720 ------------------
3721
3722 procedure Report_Error
aa720a54
AC		 3723 (S1 : String;
3724 S2 : String := "";
3725 S3 : String := "")
9f4fd324
AC		 3726 is
3727 begin
0da2c8ac 3728 -- If Keep_Going is True, output error message preceded by error header
9f4fd324
AC		 3729
3730 if Keep_Going then
3731 Total_Number_Of_Errors := Total_Number_Of_Errors + 1;
3732 Write_Str (Error_Header);
3733 Write_Str (S1);
3734 Write_Str (S2);
3735 Write_Str (S3);
3736 Write_Eol;
3737
0da2c8ac 3738 -- Otherwise just fail
9f4fd324 3739
0da2c8ac 3740 else
9f4fd324
AC		 3741 Osint.Fail (S1, S2, S3);
3742 end if;
3743 end Report_Error;
3744
3745 -------------------------
3746 -- Report_Total_Errors --
3747 -------------------------
3748
3749 procedure Report_Total_Errors (Kind : String) is
3750 begin
3751 if Total_Number_Of_Errors /= 0 then
3752 if Total_Number_Of_Errors = 1 then
3753 Osint.Fail
3754 ("One ", Kind, " error");
3755
3756 else
3757 Osint.Fail
3758 ("Total of" & Total_Number_Of_Errors'Img,
3759 ' ' & Kind & " errors");
3760 end if;
3761 end if;
3762 end Report_Total_Errors;
3763
3764 --------------
3765 -- Scan_Arg --
3766 --------------
3767
3768 procedure Scan_Arg (Arg : String) is
3769 begin
3770 pragma Assert (Arg'First = 1);
3771
3772 if Arg'Length = 0 then
3773 return;
3774 end if;
3775
0da2c8ac
AC		 3776 -- If preceding switch was -P, a project file name need to be
3777 -- specified, not a switch.
9f4fd324
AC		 3778
3779 if Project_File_Name_Expected then
3780 if Arg (1) = '-' then
3781 Osint.Fail ("project file name missing after -P");
9f4fd324
AC		 3782 else
3783 Project_File_Name_Expected := False;
3784 Project_File_Name := new String'(Arg);
3785 end if;
3786
0da2c8ac
AC		 3787 -- If preceding switch was -o, an executable name need to be
3788 -- specified, not a switch.
9f4fd324
AC		 3789
3790 elsif Output_File_Name_Expected then
3791 if Arg (1) = '-' then
3792 Osint.Fail ("output file name missing after -o");
9f4fd324
AC		 3793 else
3794 Output_File_Name_Expected := False;
3795 Output_File_Name := new String'(Arg);
3796 end if;
3797
3798 -- Set the processor/language for the following switches
3799
3800 -- -c???args: Compiler arguments
3801
0da2c8ac
AC		 3802 elsif Arg'Length >= 6
3803 and then Arg (Arg'First .. Arg'First + 1) = "-c"
3804 and then Arg (Arg'Last - 3 .. Arg'Last) = "args"
9f4fd324
AC		 3805 then
3806 declare
aa720a54 3807 OK : Boolean := False;
9f4fd324
AC		 3808 Args_String : constant String :=
3809 Arg (Arg'First + 2 .. Arg'Last - 4);
3810
3811 begin
3812 for Lang in Programming_Language loop
3813 if Args_String = Lang_Args (Lang).all then
3814 OK := True;
3815 Current_Language := Lang;
3816 exit;
3817 end if;
3818 end loop;
3819
3820 if OK then
3821 Current_Processor := Compiler;
9f4fd324
AC		 3822 else
3823 Osint.Fail ("illegal option """, Arg, """");
3824 end if;
3825 end;
3826
3827 elsif Arg = "-largs" then
3828 Current_Processor := Linker;
3829
3830 -- -gargs: gprmake
3831
3832 elsif Arg = "-gargs" then
3833 Current_Processor := None;
3834
aa720a54
AC		 3835 -- A special test is needed for the -o switch within a -largs since
3836 -- that is another way to specify the name of the final executable.
9f4fd324
AC		 3837
3838 elsif Current_Processor = Linker and then Arg = "-o" then
3839 Osint.Fail
3840 ("switch -o not allowed within a -largs. Use -o directly.");
3841
15ce9ca2 3842 -- If current processor is not gprmake directly, store the option in
9f4fd324
AC		 3843 -- the appropriate table.
3844
3845 elsif Current_Processor /= None then
3846 Add_Option (Arg);
3847
3848 -- Switches start with '-'
3849
3850 elsif Arg (1) = '-' then
3851 if Arg = "-c" then
3852 Compile_Only := True;
3853
3854 elsif Arg = "-f" then
3855 Force_Compilations := True;
3856
3857 elsif Arg = "-h" then
3858 Usage;
3859
3860 elsif Arg = "-k" then
3861 Keep_Going := True;
3862
3863 elsif Arg = "-o" then
3864 if Output_File_Name /= null then
3865 Osint.Fail ("cannot specify several -o switches");
3866
3867 else
3868 Output_File_Name_Expected := True;
3869 end if;
3870
3871 elsif Arg'Length >= 2 and then Arg (2) = 'P' then
3872 if Project_File_Name /= null then
3873 Osint.Fail ("cannot have several project files specified");
3874
3875 elsif Arg'Length = 2 then
3876 Project_File_Name_Expected := True;
3877
3878 else
3879 Project_File_Name := new String'(Arg (3 .. Arg'Last));
3880 end if;
3881
3882 elsif Arg = "-q" then
3883 Quiet_Output := True;
3884
3885 elsif Arg = "-u" then
3886 Unique_Compile := True;
3887 Compile_Only := True;
3888
3889 elsif Arg = "-v" then
3890 Verbose_Mode := True;
0da2c8ac 3891 Copyright;
9f4fd324
AC		 3892
3893 elsif Arg'Length = 4 and then Arg (1 .. 3) = "-vP"
3894 and then Arg (4) in '0' .. '2'
3895 then
3896 case Arg (4) is
3897 when '0' =>
3898 Current_Verbosity := Prj.Default;
3899 when '1' =>
3900 Current_Verbosity := Prj.Medium;
3901 when '2' =>
3902 Current_Verbosity := Prj.High;
3903 when others =>
3904 null;
3905 end case;
3906
3907 elsif Arg'Length >= 3 and then Arg (2) = 'X'
3908 and then Is_External_Assignment (Arg)
3909 then
0da2c8ac 3910 -- Is_External_Assignment has side effects when it returns True
9f4fd324 3911
15ce9ca2
AC		 3912 -- Record the -X switch, so that they can be passed to gnatmake,
3913 -- if gnatmake is called.
3914
3915 X_Switches.Increment_Last;
3916 X_Switches.Table (X_Switches.Last) := new String'(Arg);
9f4fd324
AC		 3917
3918 else
3919 Osint.Fail ("illegal option """, Arg, """");
3920 end if;
3921
3922 else
3923 -- Not a switch: must be a main
3924
3925 Mains.Add_Main (Arg);
3926 end if;
3927 end Scan_Arg;
3928
3929 -----------------
3930 -- Strip_CR_LF --
3931 -----------------
3932
3933 function Strip_CR_LF (Text : String) return String is
0da2c8ac 3934 To : String (1 .. Text'Length);
9f4fd324
AC		 3935 Index_To : Natural := 0;
3936
3937 begin
3938 for Index in Text'Range loop
3939 if (Text (Index) /= ASCII.CR) and then (Text (Index) /= ASCII.LF) then
3940 Index_To := Index_To + 1;
3941 To (Index_To) := Text (Index);
3942 end if;
3943 end loop;
3944
3945 return To (1 .. Index_To);
3946 end Strip_CR_LF;
3947
3948 -----------
3949 -- Usage --
3950 -----------
3951
3952 procedure Usage is
3953 begin
3954 if not Usage_Output then
3955 Usage_Output := True;
3956 Copyright;
3957
3958 Write_Str ("Usage: ");
3959 Osint.Write_Program_Name;
3960 Write_Str (" -P<project file> [opts] [name] {");
3961
3962 for Lang in Programming_Language loop
3963 Write_Str ("[-c");
3964 Write_Str (Lang_Args (Lang).all);
3965 Write_Str ("args opts] ");
3966 end loop;
3967
3968 Write_Str ("[-largs opts] [-gargs opts]}");
3969 Write_Eol;
3970 Write_Eol;
3971 Write_Str (" name is zero or more file names");
3972 Write_Eol;
3973 Write_Eol;
3974
3975 -- GPRMAKE switches
3976
3977 Write_Str ("gprmake switches:");
3978 Write_Eol;
3979
3980 -- Line for -c
3981
3982 Write_Str (" -c Compile only");
3983 Write_Eol;
3984
3985 -- Line for -f
3986
3987 Write_Str (" -f Force recompilations");
3988 Write_Eol;
3989
3990 -- Line for -k
3991
3992 Write_Str (" -k Keep going after compilation errors");
3993 Write_Eol;
3994
3995 -- Line for -o
3996
3997 Write_Str (" -o name Choose an alternate executable name");
3998 Write_Eol;
3999
4000 -- Line for -P
4001
4002 Write_Str (" -Pproj Use GNAT Project File proj");
4003 Write_Eol;
4004
4005 -- Line for -q
4006
4007 Write_Str (" -q Be quiet/terse");
4008 Write_Eol;
4009
4010 -- Line for -u
4011
4012 Write_Str
4013 (" -u Unique compilation. Only compile the given files");
4014 Write_Eol;
4015
4016 -- Line for -v
4017
4018 Write_Str (" -v Verbose output");
4019 Write_Eol;
4020
4021 -- Line for -vPx
4022
4023 Write_Str (" -vPx Specify verbosity when parsing Project Files");
4024 Write_Eol;
4025
4026 -- Line for -X
4027
4028 Write_Str (" -Xnm=val Specify an external reference for " &
4029 "Project Files");
4030 Write_Eol;
4031 Write_Eol;
4032
4033 -- Lines for -c*args
4034
4035 for Lang in Programming_Language loop
4036 declare
4037 Column : Positive := 13 + Lang_Args (Lang)'Length;
4038 -- " -cargs opts" is the minimum and is 13 character long
4039
4040 begin
4041 Write_Str (" -c");
4042 Write_Str (Lang_Args (Lang).all);
4043 Write_Str ("args opts");
4044
4045 loop
4046 Write_Char (' ');
4047 Column := Column + 1;
4048 exit when Column >= 17;
4049 end loop;
4050
4051 Write_Str ("opts are passed to the ");
4052 Write_Str (Lang_Display_Names (Lang).all);
4053 Write_Str (" compiler");
4054 Write_Eol;
4055 end;
4056 end loop;
4057
4058 -- Line for -largs
4059
4060 Write_Str (" -largs opts opts are passed to the linker");
4061 Write_Eol;
4062
4063 -- Line for -gargs
4064
4065 Write_Str (" -gargs opts opts directly interpreted by gprmake");
4066 Write_Eol;
4067 Write_Eol;
4068
4069 end if;
4070 end Usage;
4071
4072begin
4073 Makeutl.Do_Fail := Report_Error'Access;
4074end Makegpr;
GNU Compiler Collection
This page took 0.497139 seconds and 5 git commands to generate.