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