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