projects / gcc.git / blob
? search:


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