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