1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2004 Free Software Foundation, Inc. --
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. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
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
;
35 with GNAT
.Directory_Operations
; use GNAT
.Directory_Operations
;
36 with GNAT
.Dynamic_Tables
;
37 with GNAT
.Expect
; use GNAT
.Expect
;
39 with GNAT
.OS_Lib
; use GNAT
.OS_Lib
;
40 with GNAT
.Regpat
; use GNAT
.Regpat
;
42 with Makeutl
; use Makeutl
;
43 with MLib
.Tgt
; use MLib
.Tgt
;
44 with Namet
; use Namet
;
45 with Output
; use Output
;
47 with Osint
; use Osint
;
49 with Prj
.Com
; use Prj
.Com
;
51 with Prj
.Util
; use Prj
.Util
;
52 with Snames
; use Snames
;
54 with System
.Case_Util
; use System
.Case_Util
;
56 with Types
; use Types
;
58 package body Makegpr
is
60 Max_In_Archives
: constant := 50;
61 -- The maximum number of arguments for a single invocation of the
62 -- Archive Indexer (ar).
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++.
68 No_Argument
: aliased Argument_List
:= (1 .. 0 => null);
69 -- Null argument list representing case of no arguments
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.
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
79 Name_Compiler_Command
: Name_Id
;
80 -- Names of package IDE and its attribute Compiler_Command.
81 -- Set up by Initialize.
83 Unique_Compile
: Boolean := False;
84 -- True when switch -u is used on the command line
86 type Source_Index_Rec
is record
89 Found
: Boolean := False;
91 -- Used as Source_Indexes component to check if archive needs to be rebuilt
93 type Source_Index_Array
is array (Positive range <>) of Source_Index_Rec
;
94 type Source_Indexes_Ref
is access Source_Index_Array
;
96 procedure Free
is new Ada
.Unchecked_Deallocation
97 (Source_Index_Array
, Source_Indexes_Ref
);
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.
105 Last_Source
: Natural := 0;
106 -- The index of the last valid component of Source_Indexes
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.
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++");
116 Default_Compiler_Names : constant array
117 (First_Language_Indexes range
118 Ada_Language_Index .. C_Plus_Plus_Language_Index)
120 (Ada_Language_Index => Gnatmake_String,
121 C_Language_Index => GCC_String,
122 C_Plus_Plus_Language_Index => G_Plus_Plus_String);
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.
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.
132 Archive_Builder_Path : String_Access := null;
133 -- The path name of the archive builder (ar). To be used when spawning
136 Archive_Indexer_Path : String_Access := null;
137 -- The path name of the archive indexer (ranlib), if it exists.
139 Copyright_Output : Boolean := False;
140 Usage_Output : Boolean := False;
141 -- Flags to avoid multiple displays of Copyright notice and of Usage
143 Output_File_Name : String_Access := null;
144 -- The name given after a switch -o
146 Output_File_Name_Expected : Boolean := False;
147 -- True when last switch was -o
149 Project_File_Name : String_Access := null;
150 -- The name of the project file specified with switch -P
152 Project_File_Name_Expected : Boolean := False;
153 -- True when last switch was -P
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
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
171 Main_Project
: Project_Id
;
172 -- The project id of the main project
174 type Processor
is (None
, Linker
, Compiler
);
175 Current_Processor
: Processor
:= None
;
176 -- This variable changes when switches -*args are used
178 Current_Language
: Language_Index
:= Ada_Language_Index
;
179 -- The compiler language to consider when Processor is Compiler
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,
186 Table_Increment
=> 100);
187 Options
: array (First_Language_Indexes
) of Comp_Opts
.Instance
;
188 -- Tables to store compiling options for the different compilers
190 package Linker_Options
is new Table
.Table
191 (Table_Component_Type
=> String_Access
,
192 Table_Index_Type
=> Integer,
193 Table_Low_Bound
=> 1,
195 Table_Increment
=> 100,
196 Table_Name
=> "Makegpr.Linker_Options");
197 -- Table to store the linking options
199 package Library_Opts
is new Table
.Table
200 (Table_Component_Type
=> String_Access
,
201 Table_Index_Type
=> Integer,
202 Table_Low_Bound
=> 1,
204 Table_Increment
=> 100,
205 Table_Name
=> "Makegpr.Library_Opts");
206 -- Table to store the linking options
208 package Ada_Mains
is new Table
.Table
209 (Table_Component_Type
=> String_Access
,
210 Table_Index_Type
=> Integer,
211 Table_Low_Bound
=> 1,
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.
218 package Other_Mains
is new Table
.Table
219 (Table_Component_Type
=> Other_Source
,
220 Table_Index_Type
=> Integer,
221 Table_Low_Bound
=> 1,
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.
228 package Sources_Compiled
is new GNAT
.HTable
.Simple_HTable
229 (Header_Num
=> Header_Num
,
236 package X_Switches
is new Table
.Table
237 (Table_Component_Type
=> String_Access
,
238 Table_Index_Type
=> Integer,
239 Table_Low_Bound
=> 1,
241 Table_Increment
=> 100,
242 Table_Name
=> "Makegpr.X_Switches");
243 -- Table to store the -X switches to be passed to gnatmake
245 Initial_Argument_Count
: constant Positive := 20;
246 type Boolean_Array
is array (Positive range <>) of Boolean;
247 type Booleans
is access Boolean_Array
;
249 procedure Free
is new Ada
.Unchecked_Deallocation
(Boolean_Array
, Booleans
);
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
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.
260 Last_Argument
: Natural := 0;
261 -- Index of the last valid argument in Arguments
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.
274 -- Various switches used when spawning processes:
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;
311 CPATH
: constant String := "CPATH";
312 -- The environment variable to set when compiler is a GCC compiler
313 -- to indicate the include directory path.
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.
319 C_Plus_Plus_Is_Used
: Boolean := False;
320 -- True when there are sources in C++
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.
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.
330 Need_To_Rebuild_Global_Archive
: Boolean := False;
332 Error_Header
: constant String := "*** ERROR: ";
333 -- The beginning of error message, when Keep_Going is True
335 Need_To_Relink
: Boolean := False;
336 -- True when an executable of a language other than Ada need to be linked
338 Global_Archive_Exists
: Boolean := False;
339 -- True if there is a non empty global archive, to prevent creation
342 Path_Option
: String_Access
;
343 -- The path option switch, when supported
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
355 procedure Add_Archives
(For_Gnatmake
: Boolean);
356 -- Add to Arguments the list of archives for linking an executable
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.
362 procedure Add_Arguments
(Args
: Argument_List
; Display
: Boolean);
363 -- Add a list of arguments to Arguments. Reallocate if necessary
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.
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.
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
380 procedure Add_Switches
381 (Data
: Project_Data
;
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.
389 procedure Build_Global_Archive
;
390 -- Build the archive for the main project
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
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.
401 procedure Check_Archive_Builder
;
402 -- Check if the archive builder (ar) is there
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
410 procedure Check_For_C_Plus_Plus
;
411 -- Check if C++ is used in at least one project
414 (Source_Id
: Other_Source_Id
;
416 Local_Errors
: in out Boolean);
417 -- Compile one non-Ada source
419 procedure Compile_Individual_Sources
;
420 -- Compile the sources specified on the command line, when in
421 -- Unique_Compile mode.
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
429 procedure Compile_Sources
;
430 -- Compile the sources of languages other than Ada, if necessary
433 -- Output the Copyright notice
435 procedure Create_Archive_Dependency_File
437 First_Source
: Other_Source_Id
);
438 -- Create the archive dependency file for a library project
440 procedure Create_Global_Archive_Dependency_File
(Name
: String);
441 -- Create the archive depenency file for the main project
443 procedure Display_Command
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.
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.
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.
466 procedure Initialize
;
467 -- Do the necessary package initialization and process the command line
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.
476 procedure Link_Executables
;
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
484 procedure Report_Total_Errors
(Kind
: String);
485 -- If Total_Number_Of_Errors is not zero, report it, and fail
487 procedure Scan_Arg
(Arg
: String);
488 -- Process one command line argument
490 function Strip_CR_LF
(Text
: String) return String;
491 -- Remove characters ASCII.CR and ASCII.LF from a String
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
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.
510 ----------------------------
511 -- Recursive_Add_Archives --
512 ----------------------------
514 procedure Recursive_Add_Archives
(Project
: Project_Id
) is
516 Imported
: Project_List
;
519 procedure Add_Archive_Path
;
520 -- For a library project or the main project, add the archive
521 -- path to the arguments.
523 ----------------------
524 -- Add_Archive_Path --
525 ----------------------
527 procedure Add_Archive_Path
is
528 Increment
: Positive;
529 Prev_Last
: Positive;
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.
538 if not For_Gnatmake
then
539 if Data
.Library_Kind
= Static
then
541 (Get_Name_String
(Data
.Library_Dir
) &
542 Directory_Separator
&
543 "lib" & Get_Name_String
(Data
.Library_Name
) &
548 -- As we first insert in the reverse order,
549 -- -L<dir> is put after -l<lib>
552 ("-l" & Get_Name_String
(Data
.Library_Name
),
555 Get_Name_String
(Data
.Library_Dir
);
558 ("-L" & Name_Buffer
(1 .. Name_Len
),
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
568 if Path_Option
/= null then
570 -- If it is not the first directory, make room
571 -- at the beginning of the table, including
572 -- for a path separator.
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
);
579 for Index
in reverse 1 .. Prev_Last
loop
580 Lib_Path
.Table
(Index
+ Increment
) :=
581 Lib_Path
.Table
(Index
);
584 Lib_Path
.Table
(Increment
) := Path_Separator
;
587 -- If it is the first directory, just set
588 -- Last to the length of the directory.
590 Lib_Path
.Set_Last
(Name_Len
);
593 -- Put the directory at the beginning of the
596 for Index
in 1 .. Name_Len
loop
597 Lib_Path
.Table
(Index
) := Name_Buffer
(Index
);
603 -- For a non-library project, the only archive needed
604 -- is the one for the main project, if there is one.
606 elsif Project
= Main_Project
and then Global_Archive_Exists
then
608 (Get_Name_String
(Data
.Object_Directory
) &
609 Directory_Separator
&
610 "lib" & Get_Name_String
(Data
.Name
) &
614 end Add_Archive_Path
;
617 -- Nothing to do when there is no project specified
619 if Project
/= No_Project
then
620 Data
:= Projects
.Table
(Project
);
622 -- Nothing to do if the project has already been processed
624 if not Data
.Seen
then
626 -- Mark the project as processed, to avoid processing it again
628 Projects
.Table
(Project
).Seen
:= True;
630 Recursive_Add_Archives
(Data
.Extends
);
632 Imported
:= Data
.Imported_Projects
;
634 -- Call itself recursively for all imported projects
636 while Imported
/= Empty_Project_List
loop
637 Prj
:= Project_Lists
.Table
(Imported
).Project
;
639 if Prj
/= No_Project
then
640 while Projects
.Table
(Prj
).Extended_By
/= No_Project
loop
641 Prj
:= Projects
.Table
(Prj
).Extended_By
;
644 Recursive_Add_Archives
(Prj
);
647 Imported
:= Project_Lists
.Table
(Imported
).Next
;
650 -- If there is sources of language other than Ada in this
651 -- project, add the path of the archive to Arguments.
653 if Project
= Main_Project
654 or else Data
.Other_Sources_Present
660 end Recursive_Add_Archives
;
662 -- Start of processing for Add_Archives
665 -- First, mark all projects as not processed
667 for Project
in 1 .. Projects
.Last
loop
668 Projects
.Table
(Project
).Seen
:= False;
671 -- Take care of the run path option
673 if Path_Option
= null then
674 Path_Option
:= MLib
.Linker_Library_Path_Option
;
677 Lib_Path
.Set_Last
(0);
679 -- Add archives in the reverse order
681 Recursive_Add_Archives
(Main_Project
);
683 -- And reverse the order
686 First
: Positive := Last_Arg
+ 1;
687 Last
: Natural := Last_Argument
;
688 Temp
: String_Access
;
691 while First
< Last
loop
692 Temp
:= Arguments
(First
);
693 Arguments
(First
) := Arguments
(Last
);
694 Arguments
(Last
) := Temp
;
705 procedure Add_Argument
(Arg
: String_Access
; Display
: Boolean) is
707 -- Nothing to do if no argument is specified or if argument is empty
709 if Arg
/= null or else Arg
'Length = 0 then
711 -- Reallocate arrays if necessary
713 if Last_Argument
= Arguments
'Last then
715 New_Arguments
: constant Argument_List_Access
:=
717 (1 .. Last_Argument
+
718 Initial_Argument_Count
);
720 New_Arguments_Displayed
: constant Booleans
:=
722 (1 .. Last_Argument
+
723 Initial_Argument_Count
);
726 New_Arguments
(Arguments
'Range) := Arguments
.all;
728 -- To avoid deallocating the strings, nullify all components
729 -- of Arguments before calling Free.
731 Arguments
.all := (others => null);
734 Arguments
:= New_Arguments
;
736 New_Arguments_Displayed
(Arguments_Displayed
'Range) :=
737 Arguments_Displayed
.all;
738 Free
(Arguments_Displayed
);
739 Arguments_Displayed
:= New_Arguments_Displayed
;
743 -- Add the argument and its display indication
745 Last_Argument
:= Last_Argument
+ 1;
746 Arguments
(Last_Argument
) := Arg
;
747 Arguments_Displayed
(Last_Argument
) := Display
;
751 procedure Add_Argument
(Arg
: String; Display
: Boolean) is
752 Argument
: String_Access
:= null;
755 -- Nothing to do if argument is empty
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.
761 for Index
in 1 .. Cache_Args
.Last
loop
762 if Cache_Args
.Table
(Index
).all = Arg
then
763 Argument
:= Cache_Args
.Table
(Index
);
768 -- If the argument is not in the cache, create a new entry in the
771 if Argument
= null then
772 Argument
:= new String'(Arg);
773 Cache_Args.Increment_Last;
774 Cache_Args.Table (Cache_Args.Last) := Argument;
777 -- And add the argument
779 Add_Argument (Argument, Display);
787 procedure Add_Arguments (Args : Argument_List; Display : Boolean) is
789 -- Reallocate the arrays, if necessary
791 if Last_Argument + Args'Length > Arguments'Last then
793 New_Arguments : constant Argument_List_Access :=
795 (1 .. Last_Argument + Args'Length +
796 Initial_Argument_Count);
798 New_Arguments_Displayed : constant Booleans :=
800 (1 .. Last_Argument +
802 Initial_Argument_Count);
805 New_Arguments (1 .. Last_Argument) :=
806 Arguments (1 .. Last_Argument);
808 -- To avoid deallocating the strings, nullify all components
809 -- of Arguments before calling Free.
811 Arguments.all := (others => null);
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;
822 -- Add the new arguments and the display indications
824 Arguments (Last_Argument + 1 .. Last_Argument + Args'Length) := Args;
825 Arguments_Displayed (Last_Argument + 1 .. Last_Argument + Args'Length) :=
827 Last_Argument := Last_Argument + Args'Length;
834 procedure Add_Option (Arg : String) is
835 Option : constant String_Access := new String'(Arg
);
838 case Current_Processor
is
844 -- Add option to the linker table
846 Linker_Options
.Increment_Last
;
847 Linker_Options
.Table
(Linker_Options
.Last
) := Option
;
851 -- Add option to the compiler option table, depending on the
852 -- value of Current_Language.
854 Comp_Opts
.Increment_Last
(Options
(Current_Language
));
855 Options
(Current_Language
).Table
856 (Comp_Opts
.Last
(Options
(Current_Language
))) := Option
;
865 procedure Add_Source_Id
(Project
: Project_Id
; Id
: Other_Source_Id
) is
867 -- Reallocate the array, if necessary
869 if Last_Source
= Source_Indexes
'Last then
871 New_Indexes
: constant Source_Indexes_Ref
:=
872 new Source_Index_Array
873 (1 .. Source_Indexes
'Last +
874 Initial_Source_Index_Count
);
876 New_Indexes
(Source_Indexes
'Range) := Source_Indexes
.all;
877 Free
(Source_Indexes
);
878 Source_Indexes
:= New_Indexes
;
882 Last_Source
:= Last_Source
+ 1;
883 Source_Indexes
(Last_Source
) := (Project
, Id
, False);
886 ----------------------------
887 -- Add_Search_Directories --
888 ----------------------------
890 procedure Add_Search_Directories
891 (Data
: Project_Data
;
892 Language
: First_Language_Indexes
)
895 -- If a GNU compiler is used, set the CPATH environment variable,
896 -- if it does not already has the correct value.
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);
905 Add_Arguments
(Data
.Imported_Directories_Switches
.all, Verbose_Mode
);
907 end Add_Search_Directories
;
913 procedure Add_Switches
914 (Data
: Project_Data
;
916 Language
: Language_Index
;
919 Switches
: Variable_Value
;
920 -- The switches, if any, for the file/language
923 -- The id of the package where to look for the switches
925 Defaults
: Array_Element_Id
;
926 -- The Default_Switches associative array
928 Switches_Array
: Array_Element_Id
;
929 -- The Switches associative array
931 Element_Id
: String_List_Id
;
932 Element
: String_Element
;
935 -- First, choose the proper package
942 Pkg
:= Value_Of
(Name_Linker
, Data
.Decl
.Packages
);
945 Pkg
:= Value_Of
(Name_Compiler
, Data
.Decl
.Packages
);
948 if Pkg
/= No_Package
then
949 -- Get the Switches ("file name"), if they exist
951 Switches_Array
:= Prj
.Util
.Value_Of
952 (Name
=> Name_Switches
,
953 In_Arrays
=> Packages
.Table
(Pkg
).Decl
.Arrays
);
959 In_Array
=> Switches_Array
);
961 -- Otherwise, get the Default_Switches ("language"), if they exist
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
),
970 In_Array
=> Defaults
);
973 -- If there are switches, add them to Arguments
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
);
980 if Element
.Value
/= No_Name
then
981 Get_Name_String
(Element
.Value
);
983 if not Quiet_Output
then
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.
989 Check
(Option
=> Name_Buffer
(1 .. Name_Len
));
992 Add_Argument
(Name_Buffer
(1 .. Name_Len
), True);
995 Element_Id
:= Element
.Next
;
1001 --------------------------
1002 -- Build_Global_Archive --
1003 --------------------------
1005 procedure Build_Global_Archive
is
1006 Data
: Project_Data
:= Projects
.Table
(Main_Project
);
1007 Source_Id
: Other_Source_Id
;
1008 Source
: Other_Source
;
1011 Archive_Name
: constant String :=
1012 "lib" & Get_Name_String
(Data
.Name
) & '.' & Archive_Ext
;
1013 -- The name of the archive file for this project
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
1019 Need_To_Rebuild
: Boolean := Need_To_Rebuild_Global_Archive
;
1020 -- When True, archive will be rebuilt
1022 File
: Prj
.Util
.Text_File
;
1024 Object_Path
: Name_Id
;
1025 Time_Stamp
: Time_Stamp_Type
;
1027 Saved_Last_Argument
: Natural;
1028 First_Object
: Natural;
1033 Check_Archive_Builder
;
1035 Change_Dir
(Get_Name_String
(Data
.Object_Directory
));
1037 if not Need_To_Rebuild
then
1038 if Verbose_Mode
then
1039 Write_Str
(" Checking ");
1040 Write_Line
(Archive_Name
);
1043 -- If the archive does not exist, of course it needs to be built
1045 if not Is_Regular_File
(Archive_Name
) then
1046 Need_To_Rebuild
:= True;
1048 if Verbose_Mode
then
1049 Write_Line
(" -> archive does not exist");
1052 -- Archive does exist
1055 -- Check the archive dependency file
1057 Open
(File
, Archive_Dep_Name
);
1059 -- If the archive dependency file does not exist, we need to
1060 -- to rebuild the archive and to create its dependency file.
1062 if not Is_Valid
(File
) then
1063 Need_To_Rebuild
:= True;
1065 if Verbose_Mode
then
1066 Write_Str
(" -> archive dependency file ");
1067 Write_Str
(Archive_Dep_Name
);
1068 Write_Line
(" does not exist");
1072 -- Put all sources of language other than Ada in
1075 for Proj
in 1 .. Projects
.Last
loop
1076 Data
:= Projects
.Table
(Proj
);
1078 if not Data
.Library
then
1080 Source_Id
:= Data
.First_Other_Source
;
1082 while Source_Id
/= No_Other_Source
loop
1083 Add_Source_Id
(Proj
, Source_Id
);
1084 Source_Id
:= Other_Sources
.Table
(Source_Id
).Next
;
1089 -- Read the dependency file, line by line
1091 while not End_Of_File
(File
) loop
1092 Get_Line
(File
, Name_Buffer
, Name_Len
);
1094 -- First line is the path of the object file
1096 Object_Path
:= Name_Find
;
1097 Source_Id
:= No_Other_Source
;
1099 -- Check if this object file is for a source of this project
1101 for S
in 1 .. Last_Source
loop
1102 Source_Id
:= Source_Indexes
(S
).Id
;
1103 Source
:= Other_Sources
.Table
(Source_Id
);
1105 if (not Source_Indexes
(S
).Found
)
1106 and then Source
.Object_Path
= Object_Path
1108 -- We have found the object file: get the source
1109 -- data, and mark it as found.
1111 Source_Indexes
(S
).Found
:= True;
1116 -- If it is not for a source of this project, then the
1117 -- archive needs to be rebuilt.
1119 if Source_Id
= No_Other_Source
then
1120 Need_To_Rebuild
:= True;
1121 if Verbose_Mode
then
1123 Write_Str
(Get_Name_String
(Object_Path
));
1124 Write_Line
(" is not an object of any project");
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.
1134 if End_Of_File
(File
) then
1135 Need_To_Rebuild
:= True;
1137 if Verbose_Mode
then
1138 Write_Str
(" -> archive dependency file ");
1139 Write_Line
(" is truncated");
1145 Get_Line
(File
, Name_Buffer
, Name_Len
);
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.
1151 if Name_Len
/= Time_Stamp_Length
then
1152 Need_To_Rebuild
:= True;
1154 if Verbose_Mode
then
1155 Write_Str
(" -> archive dependency file ");
1156 Write_Line
(" is incorrectly formatted (time stamp)");
1162 Time_Stamp
:= Time_Stamp_Type
(Name_Buffer
(1 .. Name_Len
));
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.
1168 if Time_Stamp
/= Source
.Object_TS
then
1169 Need_To_Rebuild
:= True;
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");
1187 if not Need_To_Rebuild
then
1188 if Verbose_Mode
then
1189 Write_Line
(" -> up to date");
1192 -- No need to create a global archive, if there is no object
1193 -- file to put into.
1195 Global_Archive_Exists
:= Last_Source
/= 0;
1197 -- Archive needs to be rebuilt
1200 -- If archive already exists, first delete it
1202 -- Comment needed on why we discard result???
1204 if Is_Regular_File
(Archive_Name
) then
1205 Delete_File
(Archive_Name
, Discard
);
1210 -- Start with the options found in MLib.Tgt (usually just "rc")
1212 Add_Arguments
(Archive_Builder_Options
.all, True);
1214 -- Followed by the archive name
1216 Add_Argument
(Archive_Name
, True);
1218 First_Object
:= Last_Argument
;
1220 -- Followed by all the object files of the non library projects
1222 for Proj
in 1 .. Projects
.Last
loop
1223 Data
:= Projects
.Table
(Proj
);
1225 if not Data
.Library
then
1226 Source_Id
:= Data
.First_Other_Source
;
1228 while Source_Id
/= No_Other_Source
loop
1229 Source
:= Other_Sources
.Table
(Source_Id
);
1231 -- Only include object file name that have not been
1232 -- overriden in extending projects.
1234 if Is_Included_In_Global_Archive
1235 (Source
.Object_Name
, Proj
)
1238 (Get_Name_String
(Source
.Object_Path
), Verbose_Mode
);
1241 Source_Id
:= Source
.Next
;
1246 -- No need to create a global archive, if there is no object
1247 -- file to put into.
1249 Global_Archive_Exists
:= Last_Argument
> First_Object
;
1251 if Global_Archive_Exists
then
1253 -- If the archive is built, then linking will need to occur
1256 Need_To_Relink
:= True;
1258 -- Spawn the archive builder (ar)
1260 Saved_Last_Argument
:= Last_Argument
;
1261 Last_Argument
:= First_Object
+ Max_In_Archives
;
1263 if Last_Argument
> Saved_Last_Argument
then
1264 Last_Argument
:= Saved_Last_Argument
;
1267 Display_Command
(Archive_Builder
, Archive_Builder_Path
);
1270 (Archive_Builder_Path
.all,
1271 Arguments
(1 .. Last_Argument
),
1274 exit when not Success
;
1276 exit when Last_Argument
= Saved_Last_Argument
;
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;
1284 -- If the archive was built, run the archive indexer (ranlib)
1289 -- If the archive was built, run the archive indexer (ranlib),
1292 if Archive_Indexer_Path
/= null then
1294 Add_Argument
(Archive_Name
, True);
1296 Display_Command
(Archive_Indexer
, Archive_Indexer_Path
);
1299 (Archive_Indexer_Path
.all, Arguments
(1 .. 1), Success
);
1303 -- Running ranlib failed, delete the dependency file,
1306 if Is_Regular_File
(Archive_Dep_Name
) then
1307 Delete_File
(Archive_Dep_Name
, Success
);
1310 -- And report the error
1313 ("running" & Archive_Indexer
& " for project """,
1314 Get_Name_String
(Data
.Name
),
1320 -- The archive was correctly built, create its dependency file
1322 Create_Global_Archive_Dependency_File
(Archive_Dep_Name
);
1324 -- Building the archive failed, delete dependency file if one
1328 if Is_Regular_File
(Archive_Dep_Name
) then
1329 Delete_File
(Archive_Dep_Name
, Success
);
1332 -- And report the error
1335 ("building archive for project """,
1336 Get_Name_String
(Data
.Name
),
1341 end Build_Global_Archive
;
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
;
1352 Archive_Name
: constant String :=
1353 "lib" & Get_Name_String
(Data
.Name
) & '.' & Archive_Ext
;
1354 -- The name of the archive file for this project
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
1360 Need_To_Rebuild
: Boolean := Unconditionally
;
1361 -- When True, archive will be rebuilt
1363 File
: Prj
.Util
.Text_File
;
1365 Object_Name
: Name_Id
;
1366 Time_Stamp
: Time_Stamp_Type
;
1367 Driver_Name
: Name_Id
:= No_Name
;
1369 Lib_Opts
: Argument_List_Access
:= No_Argument
'Unrestricted_Access;
1371 Check_Archive_Builder
;
1373 -- If Unconditionally is False, check if the archive need to be built
1375 if not Need_To_Rebuild
then
1376 if Verbose_Mode
then
1377 Write_Str
(" Checking ");
1378 Write_Line
(Archive_Name
);
1381 -- If the archive does not exist, of course it needs to be built
1383 if not Is_Regular_File
(Archive_Name
) then
1384 Need_To_Rebuild
:= True;
1386 if Verbose_Mode
then
1387 Write_Line
(" -> archive does not exist");
1390 -- Archive does exist
1393 -- Check the archive dependency file
1395 Open
(File
, Archive_Dep_Name
);
1397 -- If the archive dependency file does not exist, we need to
1398 -- to rebuild the archive and to create its dependency file.
1400 if not Is_Valid
(File
) then
1401 Need_To_Rebuild
:= True;
1403 if Verbose_Mode
then
1404 Write_Str
(" -> archive dependency file ");
1405 Write_Str
(Archive_Dep_Name
);
1406 Write_Line
(" does not exist");
1410 -- Put all sources of language other than Ada in Source_Indexes
1413 Source_Id
:= Data
.First_Other_Source
;
1415 while Source_Id
/= No_Other_Source
loop
1416 Add_Source_Id
(Project
, Source_Id
);
1417 Source_Id
:= Other_Sources
.Table
(Source_Id
).Next
;
1420 -- Read the dependency file, line by line
1422 while not End_Of_File
(File
) loop
1423 Get_Line
(File
, Name_Buffer
, Name_Len
);
1425 -- First line is the name of an object file
1427 Object_Name
:= Name_Find
;
1428 Source_Id
:= No_Other_Source
;
1430 -- Check if this object file is for a source of this project
1432 for S
in 1 .. Last_Source
loop
1433 if (not Source_Indexes
(S
).Found
) and then
1435 (Source_Indexes
(S
).Id
).Object_Name
=
1438 -- We have found the object file: get the source
1439 -- data, and mark it as found.
1441 Source_Id
:= Source_Indexes
(S
).Id
;
1442 Source
:= Other_Sources
.Table
(Source_Id
);
1443 Source_Indexes
(S
).Found
:= True;
1448 -- If it is not for a source of this project, then the
1449 -- archive needs to be rebuilt.
1451 if Source_Id
= No_Other_Source
then
1452 Need_To_Rebuild
:= True;
1454 if Verbose_Mode
then
1456 Write_Str
(Get_Name_String
(Object_Name
));
1457 Write_Line
(" is not an object of the project");
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.
1467 if End_Of_File
(File
) then
1468 Need_To_Rebuild
:= True;
1470 if Verbose_Mode
then
1471 Write_Str
(" -> archive dependency file ");
1472 Write_Line
(" is truncated");
1478 Get_Line
(File
, Name_Buffer
, Name_Len
);
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.
1484 if Name_Len
/= Time_Stamp_Length
then
1485 Need_To_Rebuild
:= True;
1487 if Verbose_Mode
then
1488 Write_Str
(" -> archive dependency file ");
1489 Write_Line
(" is incorrectly formatted (time stamp)");
1495 Time_Stamp
:= Time_Stamp_Type
(Name_Buffer
(1 .. Name_Len
));
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.
1501 if Time_Stamp
/= Source
.Object_TS
then
1502 Need_To_Rebuild
:= True;
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");
1517 if not Need_To_Rebuild
then
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.
1523 for Index
in 1 .. Last_Source
loop
1524 if not Source_Indexes
(Index
).Found
then
1525 Need_To_Rebuild
:= True;
1527 if Verbose_Mode
then
1528 Source_Id
:= Source_Indexes
(Index
).Id
;
1529 Source
:= Other_Sources
.Table
(Source_Id
);
1531 Write_Str
(Get_Name_String
(Source
.Object_Name
));
1532 Write_Str
(" is not in the archive ");
1533 Write_Line
("dependency file");
1541 if (not Need_To_Rebuild
) and Verbose_Mode
then
1542 Write_Line
(" -> up to date");
1548 -- Build the library if necessary
1550 if Need_To_Rebuild
then
1552 -- If a library is built, then linking will need to occur
1555 Need_To_Relink
:= True;
1559 -- If there are sources in Ada, then gnatmake will build the
1560 -- library, so nothing to do.
1562 if not Data
.Languages
(Ada_Language_Index
) then
1564 -- Get all the object files of the project
1566 Source_Id
:= Data
.First_Other_Source
;
1568 while Source_Id
/= No_Other_Source
loop
1569 Source
:= Other_Sources
.Table
(Source_Id
);
1571 (Get_Name_String
(Source
.Object_Name
), Verbose_Mode
);
1572 Source_Id
:= Source
.Next
;
1575 -- If it is a library, it need to be built it the same way
1576 -- Ada libraries are built.
1578 if Data
.Library_Kind
= Static
then
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
));
1586 -- Link with g++ if C++ is one of the languages, otherwise
1587 -- building the library may fail with unresolved symbols.
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
);
1594 if Compiler_Is_Gcc
(C_Plus_Plus_Language_Index
) then
1596 Add_Str_To_Name_Buffer
1597 (Compiler_Names
(C_Plus_Plus_Language_Index
).all);
1598 Driver_Name
:= Name_Find
;
1602 -- If Library_Options is specified, add these options
1605 Library_Options
: constant Variable_Value
:=
1607 (Name_Library_Options
,
1608 Data
.Decl
.Attributes
);
1611 if not Library_Options
.Default
then
1613 Current
: String_List_Id
:= Library_Options
.Values
;
1614 Element
: String_Element
;
1617 while Current
/= Nil_String
loop
1618 Element
:= String_Elements
.Table
(Current
);
1619 Get_Name_String
(Element
.Value
);
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));
1627 Current := Element.Next;
1633 new Argument_List'(Argument_List
1634 (Library_Opts
.Table
(1 .. Library_Opts
.Last
)));
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
,
1649 Auto_Init
=> False);
1653 -- Create fake empty archive, so we can check its time stamp later
1656 Archive
: Ada
.Text_IO
.File_Type
;
1659 Create
(Archive
, Out_File
, Archive_Name
);
1663 Create_Archive_Dependency_File
1664 (Archive_Dep_Name
, Data
.First_Other_Source
);
1672 procedure Check
(Option
: String) is
1673 First
: Positive := Option
'First;
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 """);
1681 Write_Str
(""" is suspicious; consider using ");
1684 while Last
<= Option
'Last loop
1685 if Option
(Last
) = ' ' then
1686 if First
/= Option
'First then
1691 Write_Str
(Option
(First
.. Last
- 1));
1694 while Last
<= Option
'Last and then Option
(Last
) = ' ' loop
1701 if Last
= Option
'Last then
1702 if First
/= Option
'First then
1707 Write_Str
(Option
(First
.. Last
));
1715 Write_Line
(" instead");
1721 ---------------------------
1722 -- Check_Archive_Builder --
1723 ---------------------------
1725 procedure Check_Archive_Builder
is
1727 -- First, make sure that the archive builder (ar) is on the path
1729 if Archive_Builder_Path
= null then
1730 Archive_Builder_Path
:= Locate_Exec_On_Path
(Archive_Builder
);
1732 if Archive_Builder_Path
= null then
1734 ("unable to locate archive builder """,
1739 -- If there is an archive indexer (ranlib), try to locate it on the
1740 -- path. Don't fail if it is not found.
1742 if Archive_Indexer
/= "" then
1743 Archive_Indexer_Path
:= Locate_Exec_On_Path
(Archive_Indexer
);
1746 end Check_Archive_Builder
;
1748 ------------------------------
1749 -- Check_Compilation_Needed --
1750 ------------------------------
1752 procedure Check_Compilation_Needed
1753 (Source
: Other_Source
;
1754 Need_To_Compile
: out Boolean)
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
);
1761 Source_In_Dependencies
: Boolean := False;
1762 -- Set True if source was found in dependency file of its object file
1764 Dep_File
: Prj
.Util
.Text_File
;
1769 -- Assume the worst, so that statement "return;" may be used if there
1772 Need_To_Compile
:= True;
1774 if Verbose_Mode
then
1775 Write_Str
(" Checking ");
1776 Write_Str
(Source_Name
);
1777 Write_Line
(" ... ");
1780 -- If object file does not exist, of course source need to be compiled
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");
1792 -- If the object file has been created before the last modification
1793 -- of the source, the source need to be recompiled.
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");
1805 -- If there is no dependency file, then the source needs to be
1806 -- recompiled and the dependency file need to be created.
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");
1818 -- The source needs to be recompiled if the source has been modified
1819 -- after the dependency file has been created.
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");
1831 -- Look for all dependencies
1833 Open
(Dep_File
, Dep_Name
);
1835 -- If dependency file cannot be open, we need to recompile the source
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
);
1847 End_Of_File_Reached
: Boolean := False;
1851 if End_Of_File
(Dep_File
) then
1852 End_Of_File_Reached
:= True;
1856 Get_Line
(Dep_File
, Name_Buffer
, Name_Len
);
1858 exit when Name_Len
> 0 and then Name_Buffer
(1) /= '#';
1861 -- If dependency file contains only empty lines or comments, then
1862 -- dependencies are unknown, and the source needs to be recompiled.
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");
1877 Finish
:= Index
(Name_Buffer
(1 .. Name_Len
), ": ");
1879 -- First line must start with name of object file, followed by colon
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");
1892 Start
:= Finish
+ 2;
1894 -- Process each line
1898 Line
: constant String := Name_Buffer
(1 .. Name_Len
);
1899 Last
: constant Natural := Name_Len
;
1904 -- Find the beginning of the next source path name
1906 while Start
< Last
and then Line
(Start
) = ' ' loop
1910 -- Go to next line when there is a continuation character \
1911 -- at the end of the line.
1913 exit Name_Loop
when Start
= Last
1914 and then Line
(Start
) = '\';
1916 -- We should not be at the end of the line, without
1917 -- a continuation character \.
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");
1930 -- Look for the end of the source path name
1933 while Finish
< Last
and then Line
(Finish
+ 1) /= ' ' loop
1934 Finish
:= Finish
+ 1;
1937 -- Check this source
1940 Src_Name
: constant String :=
1942 (Name
=> Line
(Start
.. Finish
),
1943 Case_Sensitive
=> False);
1944 Src_TS
: Time_Stamp_Type
;
1947 -- If it is original source, set Source_In_Dependencies
1949 if Src_Name
= Source_Path
then
1950 Source_In_Dependencies
:= True;
1954 Add_Str_To_Name_Buffer
(Src_Name
);
1955 Src_TS
:= File_Stamp
(Name_Find
);
1957 -- If the source does not exist, we need to recompile
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");
1969 -- If the source has been modified after the object file,
1970 -- we need to recompile.
1972 elsif Src_TS
> Source
.Object_TS
then
1973 if Verbose_Mode
then
1974 Write_Str
(" -> source ");
1975 Write_Str
(Src_Name
);
1977 (" has time stamp later than object file");
1985 -- If the source path name ends the line, we are done.
1987 exit Line_Loop
when Finish
= Last
;
1989 -- Go get the next source on the line
1991 Start
:= Finish
+ 1;
1995 -- If we are here, we had a continuation character \ at the end
1996 -- of the line, so we continue with the next line.
1998 Get_Line
(Dep_File
, Name_Buffer
, Name_Len
);
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.
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");
2019 -- If we are here, then everything is OK, and we don't need
2022 if Verbose_Mode
then
2023 Write_Line
(" -> up to date");
2026 Need_To_Compile
:= False;
2027 end Check_Compilation_Needed
;
2029 ---------------------------
2030 -- Check_For_C_Plus_Plus --
2031 ---------------------------
2033 procedure Check_For_C_Plus_Plus
is
2035 C_Plus_Plus_Is_Used
:= False;
2037 for Project
in 1 .. Projects
.Last
loop
2039 Projects
.Table
(Project
).Languages
(C_Plus_Plus_Language_Index
)
2041 C_Plus_Plus_Is_Used
:= True;
2045 end Check_For_C_Plus_Plus
;
2052 (Source_Id
: Other_Source_Id
;
2053 Data
: in Project_Data
;
2054 Local_Errors
: in out Boolean)
2056 Source
: Other_Source
:= Other_Sources
.Table
(Source_Id
);
2058 CPATH
: String_Access
:= null;
2061 -- If the compiler is not known yet, get its path name
2063 if Compiler_Names
(Source
.Language
) = null then
2064 Get_Compiler
(Source
.Language
);
2067 -- For non GCC compilers, get the dependency file, first calling the
2068 -- compiler with the switch -M.
2070 if not Compiler_Is_Gcc
(Source
.Language
) then
2073 -- Add the source name, preceded by -M
2075 Add_Argument
(Dash_M
, True);
2076 Add_Argument
(Get_Name_String
(Source
.Path_Name
), True);
2078 -- Add the compiling switches for this source found in
2079 -- package Compiler of the project file, if they exist.
2082 (Data
, Compiler
, Source
.Language
, Source
.File_Name
);
2084 -- Add the compiling switches for the language specified
2085 -- on the command line, if any.
2088 J
in 1 .. Comp_Opts
.Last
(Options
(Source
.Language
))
2090 Add_Argument
(Options
(Source
.Language
).Table
(J
), True);
2093 -- Finally, add imported directory switches for this project file
2095 Add_Search_Directories
(Data
, Source
.Language
);
2097 -- And invoke the compiler using GNAT.Expect
2100 (Compiler_Names
(Source
.Language
).all,
2101 Compiler_Paths
(Source
.Language
));
2106 Compiler_Paths
(Source
.Language
).all,
2107 Arguments
(1 .. Last_Argument
),
2109 Err_To_Out
=> True);
2112 Dep_File
: Ada
.Text_IO
.File_Type
;
2113 Result
: Expect_Match
;
2117 -- Create the dependency file
2119 Create
(Dep_File
, Out_File
, Get_Name_String
(Source
.Dep_Name
));
2122 Expect
(FD
, Result
, Line_Matcher
);
2124 exit when Result
= Expect_Timeout
;
2127 S
: constant String := Strip_CR_LF
(Expect_Out
(FD
));
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.
2136 Put_Line
(Dep_File
, S
);
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.
2146 Delete_File
(Get_Name_String
(Source
.Dep_Name
), Success
);
2149 when Process_Died
=>
2151 -- This is the normal outcome. Just close the file
2158 -- Something wrong happened. It is safer to delete the
2159 -- dependency file, otherwise the dependencies may be wrong.
2163 if Is_Open
(Dep_File
) then
2167 Delete_File
(Get_Name_String
(Source
.Dep_Name
), Success
);
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.
2175 when Invalid_Process
=>
2176 Delete_File
(Get_Name_String
(Source
.Dep_Name
), Success
);
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.
2186 if Compiler_Is_Gcc
(Source
.Language
) then
2187 Add_Argument
(Dash_x
, Verbose_Mode
);
2189 (Get_Name_String
(Language_Names
.Table
(Source
.Language
)),
2193 Add_Argument
(Dash_c
, True);
2195 -- Add the compiling switches for this source found in
2196 -- package Compiler of the project file, if they exist.
2199 (Data
, Compiler
, Source
.Language
, Source
.File_Name
);
2201 -- Specify the source to be compiled
2203 Add_Argument
(Get_Name_String
(Source
.Path_Name
), True);
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
2210 if Data
.Library
and then Data
.Library_Kind
/= Static
then
2211 Add_Argument
(PIC_Option
, True);
2214 -- Indicate the name of the object
2216 Add_Argument
(Dash_o
, True);
2217 Add_Argument
(Get_Name_String
(Source
.Object_Name
), True);
2219 -- When compiler is GCC, use the magic switch that creates
2220 -- the dependency file in the correct format.
2222 if Compiler_Is_Gcc
(Source
.Language
) then
2224 ("-Wp,-MD," & Get_Name_String
(Source
.Dep_Name
),
2228 -- Add the compiling switches for the language specified
2229 -- on the command line, if any.
2231 for J
in 1 .. Comp_Opts
.Last
(Options
(Source
.Language
)) loop
2232 Add_Argument
(Options
(Source
.Language
).Table
(J
), True);
2235 -- Finally, add the imported directory switches for this
2236 -- project file (or, for gcc compilers, set up the CPATH env var
2239 Add_Search_Directories
(Data
, Source
.Language
);
2241 -- Set CPATH, if compiler is GCC
2243 if Compiler_Is_Gcc
(Source
.Language
) then
2244 CPATH
:= Current_Include_Paths
(Source
.Language
);
2247 -- And invoke the compiler
2250 (Name
=> Compiler_Names
(Source
.Language
).all,
2251 Path
=> Compiler_Paths
(Source
.Language
),
2255 (Compiler_Paths
(Source
.Language
).all,
2256 Arguments
(1 .. Last_Argument
),
2259 -- Case of successful compilation
2263 -- Update the time stamp of the object file
2265 Source
.Object_TS
:= File_Stamp
(Source
.Object_Name
);
2267 -- Do some sanity checks
2269 if Source
.Object_TS
= Empty_Time_Stamp
then
2270 Local_Errors
:= True;
2273 Get_Name_String
(Source
.Object_Name
),
2274 " has not been created");
2276 elsif Source
.Object_TS
< Source
.Source_TS
then
2277 Local_Errors
:= True;
2280 Get_Name_String
(Source
.Object_Name
),
2281 " has not been modified");
2284 -- Everything looks fine, update the Other_Sources table
2286 Other_Sources
.Table
(Source_Id
) := Source
;
2289 -- Compilation failed
2292 Local_Errors
:= True;
2295 Get_Name_String
(Source
.Path_Name
),
2300 --------------------------------
2301 -- Compile_Individual_Sources --
2302 --------------------------------
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;
2312 Ada_Is_A_Language
: constant Boolean :=
2313 Data
.Languages
(Ada_Language_Index
);
2317 To_Mixed
(Project_Name
);
2318 Compile_Only
:= True;
2320 Get_Imported_Directories
(Main_Project
, Data
);
2321 Projects
.Table
(Main_Project
) := Data
;
2323 -- Compilation will occur in the object directory
2325 Change_Dir
(Get_Name_String
(Data
.Object_Directory
));
2327 if not Data
.Other_Sources_Present
then
2328 if Ada_Is_A_Language
then
2333 Main
: constant String := Mains
.Next_Main
;
2335 exit when Main
'Length = 0;
2336 Ada_Mains
.Increment_Last
;
2337 Ada_Mains
.Table
(Ada_Mains
.Last
) := new String'(Main);
2343 ("project ", Project_Name, " contains no source");
2351 Main : constant String := Mains.Next_Main;
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;
2359 if not Sources_Compiled.Get (Source_Name) then
2360 Sources_Compiled.Set (Source_Name, True);
2361 Source_Id := Data.First_Other_Source;
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;
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
);
2377 " is not a valid source of project ",
2382 Compile
(Source_Id
, Data
, Dummy
);
2389 if Ada_Mains
.Last
> 0 then
2391 -- Invoke gnatmake for all Ada sources
2394 Add_Argument
(Dash_u
, True);
2396 for Index
in 1 .. Ada_Mains
.Last
loop
2397 Add_Argument
(Ada_Mains
.Table
(Index
), True);
2400 Compile_Link_With_Gnatmake
(Mains_Specified
=> False);
2402 end Compile_Individual_Sources
;
2404 --------------------------------
2405 -- Compile_Link_With_Gnatmake --
2406 --------------------------------
2408 procedure Compile_Link_With_Gnatmake
(Mains_Specified
: Boolean) is
2409 Data
: constant Project_Data
:= Projects
.Table
(Main_Project
);
2413 -- Array Arguments may already contain some arguments, so we don't
2414 -- set Last_Argument to 0.
2416 -- Get the gnatmake to invoke
2418 Get_Compiler
(Ada_Language_Index
);
2420 -- Specify the project file
2422 Add_Argument
(Dash_P
, True);
2423 Add_Argument
(Get_Name_String
(Data
.Path_Name
), True);
2425 -- Add the -X switches, if any
2427 for Index
in 1 .. X_Switches
.Last
loop
2428 Add_Argument
(X_Switches
.Table
(Index
), True);
2431 -- If Mains_Specified is True, find the mains in package Mains
2433 if Mains_Specified
then
2438 Main
: constant String := Mains
.Next_Main
;
2440 exit when Main
'Length = 0;
2441 Add_Argument
(Main
, True);
2446 -- Specify output file name, if any was specified on the command line
2448 if Output_File_Name
/= null then
2449 Add_Argument
(Dash_o
, True);
2450 Add_Argument
(Output_File_Name
, True);
2453 -- Transmit some switches to gnatmake
2457 if Compile_Only
then
2458 Add_Argument
(Dash_c
, True);
2464 Add_Argument
(Dash_k
, True);
2469 if Force_Compilations
then
2470 Add_Argument
(Dash_f
, True);
2475 if Verbose_Mode
then
2476 Add_Argument
(Dash_v
, True);
2481 if Quiet_Output
then
2482 Add_Argument
(Dash_q
, True);
2487 case Current_Verbosity
is
2492 Add_Argument
(Dash_vP1
, True);
2495 Add_Argument
(Dash_vP2
, True);
2498 -- If there are compiling options for Ada, transmit them to gnatmake
2500 if Comp_Opts
.Last
(Options
(Ada_Language_Index
)) /= 0 then
2501 Add_Argument
(Dash_cargs
, True);
2503 for Arg
in 1 .. Comp_Opts
.Last
(Options
(Ada_Language_Index
)) loop
2504 Add_Argument
(Options
(Ada_Language_Index
).Table
(Arg
), True);
2508 if not Compile_Only
then
2512 if Linker_Options
.Last
/= 0 then
2513 Add_Argument
(Dash_largs
, True);
2515 Add_Argument
(Dash_largs
, Verbose_Mode
);
2520 Add_Archives
(For_Gnatmake
=> True);
2522 -- If there are linking options from the command line,
2523 -- transmit them to gnatmake.
2525 for Arg
in 1 .. Linker_Options
.Last
loop
2526 Add_Argument
(Linker_Options
.Table
(Arg
), True);
2530 -- And invoke gnatmake
2533 (Compiler_Names
(Ada_Language_Index
).all,
2534 Compiler_Paths
(Ada_Language_Index
));
2537 (Compiler_Paths
(Ada_Language_Index
).all,
2538 Arguments
(1 .. Last_Argument
),
2541 -- Report an error if call to gnatmake failed
2546 Compiler_Names
(Ada_Language_Index
).all,
2550 end Compile_Link_With_Gnatmake
;
2552 ---------------------
2553 -- Compile_Sources --
2554 ---------------------
2556 procedure Compile_Sources
is
2557 Data
: Project_Data
;
2558 Source_Id
: Other_Source_Id
;
2559 Source
: Other_Source
;
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.
2565 Need_To_Compile
: Boolean;
2566 -- Set to True when a source needs to be compiled/recompiled.
2568 Need_To_Rebuild_Archive
: Boolean := Force_Compilations
;
2569 -- True when the archive needs to be built/rebuilt unconditionally
2572 -- Loop through project files
2574 for Project
in 1 .. Projects
.Last
loop
2575 Local_Errors
:= False;
2576 Data
:= Projects
.Table
(Project
);
2578 -- Nothing to do when no sources of language other than Ada
2580 if (not Data
.Virtual
) and then Data
.Other_Sources_Present
then
2582 -- If the imported directory switches are unknown, compute them
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
;
2590 Need_To_Rebuild_Archive
:= Force_Compilations
;
2592 -- Compilation will occur in the object directory
2594 Change_Dir
(Get_Name_String
(Data
.Object_Directory
));
2596 Source_Id
:= Data
.First_Other_Source
;
2598 -- Process each source one by one
2600 while Source_Id
/= No_Other_Source
loop
2601 Source
:= Other_Sources
.Table
(Source_Id
);
2602 Need_To_Compile
:= Force_Compilations
;
2604 -- Check if compilation is needed
2606 if not Need_To_Compile
then
2607 Check_Compilation_Needed
(Source
, Need_To_Compile
);
2610 -- Proceed, if compilation is needed
2612 if Need_To_Compile
then
2614 -- If a source is compiled/recompiled, of course the
2615 -- archive will need to be built/rebuilt.
2617 Need_To_Rebuild_Archive
:= True;
2618 Compile
(Source_Id
, Data
, Local_Errors
);
2621 -- Next source, if any
2623 Source_Id
:= Source
.Next
;
2626 if Need_To_Rebuild_Archive
and then (not Data
.Library
) then
2627 Need_To_Rebuild_Global_Archive
:= True;
2630 -- If there was no compilation error and -c was not used,
2631 -- build / rebuild the archive if necessary.
2634 and then Data
.Library
2635 and then not Data
.Languages
(Ada_Language_Index
)
2636 and then not Compile_Only
2638 Build_Library
(Project
, Need_To_Rebuild_Archive
);
2642 end Compile_Sources
;
2648 procedure Copyright
is
2650 -- Only output the Copyright notice once
2652 if not Copyright_Output
then
2653 Copyright_Output
:= True;
2655 Write_Str
("GPRMAKE ");
2656 Write_Str
(Gnatvsn
.Gnat_Version_String
);
2657 Write_Str
(" Copyright 2004 Free Software Foundation, Inc.");
2662 ------------------------------------
2663 -- Create_Archive_Dependency_File --
2664 ------------------------------------
2666 procedure Create_Archive_Dependency_File
2668 First_Source
: Other_Source_Id
)
2670 Source_Id
: Other_Source_Id
:= First_Source
;
2671 Source
: Other_Source
;
2672 Dep_File
: Ada
.Text_IO
.File_Type
;
2676 -- Create the file in Append mode, to avoid automatic insertion of
2677 -- an end of line if file is empty.
2679 Create
(Dep_File
, Append_File
, Name
);
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
;
2692 if Is_Open
(Dep_File
) then
2695 end Create_Archive_Dependency_File
;
2697 -------------------------------------------
2698 -- Create_Global_Archive_Dependency_File --
2699 -------------------------------------------
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
;
2709 -- Create the file in Append mode, to avoid automatic insertion of
2710 -- an end of line if file is empty.
2712 Create
(Dep_File
, Append_File
, Name
);
2714 -- Get all the object files of non-Ada sources in non-library projects
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
;
2720 while Source_Id
/= No_Other_Source
loop
2721 Source
:= Other_Sources
.Table
(Source_Id
);
2723 -- Put only those object files that are in the global archive
2725 if Is_Included_In_Global_Archive
2726 (Source
.Object_Name
, Project
)
2728 Put_Line
(Dep_File
, Get_Name_String
(Source
.Object_Path
));
2729 Put_Line
(Dep_File
, String (Source
.Object_TS
));
2732 Source_Id
:= Source
.Next
;
2741 if Is_Open
(Dep_File
) then
2744 end Create_Global_Archive_Dependency_File
;
2746 ---------------------
2747 -- Display_Command --
2748 ---------------------
2750 procedure Display_Command
2752 Path
: String_Access
;
2753 CPATH
: String_Access
:= null)
2756 -- Only display the command in Verbose Mode (-v) or when
2757 -- not in Quiet Output (no -q).
2759 if Verbose_Mode
or (not Quiet_Output
) then
2761 -- In Verbose Mode output the full path of the spawned process
2763 if Verbose_Mode
then
2764 if CPATH
/= null then
2765 Write_Str
("CPATH = ");
2766 Write_Line
(CPATH
.all);
2769 Write_Str
(Path
.all);
2775 -- Display only the arguments for which the display flag is set
2776 -- (in Verbose Mode, the display flag is set for all arguments)
2778 for Arg
in 1 .. Last_Argument
loop
2779 if Arguments_Displayed
(Arg
) then
2781 Write_Str
(Arguments
(Arg
).all);
2787 end Display_Command
;
2793 procedure Get_Compiler
(For_Language
: First_Language_Indexes
) is
2794 Data
: constant Project_Data
:= Projects
.Table
(Main_Project
);
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
2800 Compiler
: constant Variable_Value
:=
2802 (Name
=> Language_Names
.Table
(For_Language
),
2804 Attribute_Or_Array_Name
=> Name_Compiler_Command
,
2806 -- The value of Compiler_Command ("language") in package IDE, if defined
2809 -- No need to do it again if the compiler is known for this language
2811 if Compiler_Names
(For_Language
) = null then
2813 -- If compiler command is not defined for this language in package
2814 -- IDE, use the default compiler for this language.
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
);
2823 ("unknow compiler name for language """,
2824 Get_Name_String
(Language_Names
.Table
(For_Language
)),
2829 Compiler_Names
(For_Language
) :=
2830 new String'(Get_Name_String (Compiler.Value));
2833 -- Check we have a GCC compiler (name ends with "gcc" or "g++")
2836 Comp_Name : constant String := Compiler_Names (For_Language).all;
2837 Last3 : String (1 .. 3);
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++");
2844 Compiler_Is_Gcc (For_Language) := False;
2848 -- Locate the compiler on the path
2850 Compiler_Paths (For_Language) :=
2851 Locate_Exec_On_Path (Compiler_Names (For_Language).all);
2853 -- Fail if compiler cannot be found
2855 if Compiler_Paths (For_Language) = null then
2856 if For_Language = Ada_Language_Index then
2858 ("unable to locate """,
2859 Compiler_Names (For_Language).all,
2864 ("unable to locate " &
2865 Get_Name_String (Language_Names.Table (For_Language)),
2866 " compiler """, Compiler_Names (For_Language).all & '"');
2872 ------------------------------
2873 -- Get_Imported_Directories --
2874 ------------------------------
2876 procedure Get_Imported_Directories
2877 (Project : Project_Id;
2878 Data : in out Project_Data)
2880 Imported_Projects : Project_List := Data.Imported_Projects;
2882 Path_Length : Natural := 0;
2883 Position : Natural := 0;
2885 procedure Add (Source_Dirs : String_List_Id);
2886 -- Add a list of source directories
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.
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;
2902 -- Add each source directory path name, preceded by "-I
" to Arguments
2904 while Element_Id /= Nil_String loop
2905 Element := String_Elements.Table (Element_Id);
2907 if Element.Value /= No_Name then
2908 Get_Name_String (Element.Value);
2910 if Name_Len > 0 then
2911 -- Remove a trailing directory separator: this may cause
2912 -- problems on Windows.
2915 and then Name_Buffer (Name_Len) = Directory_Separator
2917 Name_Len := Name_Len - 1;
2921 Arg : constant String :=
2922 "-I
" & Name_Buffer (1 .. Name_Len);
2924 -- Check if directory is already in the list.
2925 -- If it is, no need to put it again.
2927 for Index in 1 .. Last_Argument loop
2928 if Arguments (Index).all = Arg then
2935 if Path_Length /= 0 then
2936 Path_Length := Path_Length + 1;
2939 Path_Length := Path_Length + Name_Len;
2941 Add_Argument (Arg, True);
2947 Element_Id := Element.Next;
2951 ------------------------
2952 -- Recursive_Get_Dirs --
2953 ------------------------
2955 procedure Recursive_Get_Dirs (Prj : Project_Id) is
2956 Data : Project_Data;
2957 Imported : Project_List;
2960 -- Nothing to do if project is undefined
2962 if Prj /= No_Project then
2963 Data := Projects.Table (Prj);
2965 -- Nothing to do if project has already been processed
2967 if not Data.Seen then
2969 -- Mark the project as processed, to avoid multiple processing
2970 -- of the same project.
2972 Projects.Table (Prj).Seen := True;
2974 -- Add the source directories of this project
2976 if not Data.Virtual then
2977 Add (Data.Source_Dirs);
2980 Recursive_Get_Dirs (Data.Extends);
2982 Imported := Data.Imported_Projects;
2984 -- Call itself for all imported projects, if any
2986 while Imported /= Empty_Project_List loop
2987 Recursive_Get_Dirs (Project_Lists.Table (Imported).Project);
2988 Imported := Project_Lists.Table (Imported).Next;
2992 end Recursive_Get_Dirs;
2994 -- Start of processing for Get_Imported_Directories
2997 -- First, mark all project as not processed
2999 for J in 1 .. Projects.Last loop
3000 Projects.Table (J).Seen := False;
3007 -- Process this project individually, project data are already known
3009 Projects.Table (Project).Seen := True;
3011 Add (Data.Source_Dirs);
3013 Recursive_Get_Dirs (Data.Extends);
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;
3020 Data.Imported_Directories_Switches :=
3021 new Argument_List'(Arguments (1 .. Last_Argument));
3023 -- Create the Include_Path, from the Arguments
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;
3030 for Arg in 2 .. Last_Argument loop
3031 Position := Position + 1;
3032 Data.Include_Path (Position) := Path_Separator;
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;
3040 end Get_Imported_Directories;
3046 procedure Gprmake is
3050 if Verbose_Mode then
3052 Write_Str ("Parsing Project File
""");
3053 Write_Str (Project_File_Name.all);
3058 -- Parse and process project files for other languages (not for Ada)
3061 (Project => Main_Project,
3062 Project_File_Name => Project_File_Name.all,
3063 Packages_To_Check => Packages_To_Check);
3065 -- Fail if parsing/processing was unsuccessful
3067 if Main_Project = No_Project then
3068 Osint.Fail ("""", Project_File_Name.all, """ processing failed
");
3071 if Verbose_Mode then
3073 Write_Str ("Parsing
of Project File
""");
3074 Write_Str (Project_File_Name.all);
3075 Write_Str (""" is finished
.");
3079 -- If -f was specified, we will certainly need to link (except when
3080 -- -u or -c were specified, of course).
3082 Need_To_Relink := Force_Compilations;
3084 if Unique_Compile then
3085 if Mains.Number_Of_Mains = 0 then
3087 ("No source specified to compile
in 'unique compile' mode
");
3089 Compile_Individual_Sources;
3090 Report_Total_Errors ("compilation
");
3095 Data : constant Prj.Project_Data := Projects.Table (Main_Project);
3097 if Data.Library and then Mains.Number_Of_Mains /= 0 then
3099 ("Cannot specify mains on the command line
" &
3100 "for a Library Project
");
3103 -- First check for C++, to link libraries with g++,
3106 Check_For_C_Plus_Plus;
3108 -- Compile sources and build archives for library project,
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.
3117 Report_Total_Errors ("compilation
");
3119 -- If -c was not specified, link the executables,
3120 -- if there are any.
3122 if not Compile_Only and then not Data.Library then
3123 Build_Global_Archive;
3127 -- When Keep_Going is True, if we had some errors, fail, reporting
3128 -- the number of linking errors.
3130 Report_Total_Errors ("linking
");
3139 procedure Initialize is
3141 -- Do some necessary package initializations
3149 -- Set Name_Ide and Name_Compiler_Command
3152 Add_Str_To_Name_Buffer ("ide
");
3153 Name_Ide := Name_Find;
3156 Add_Str_To_Name_Buffer ("compiler_command
");
3157 Name_Compiler_Command := Name_Find;
3159 -- Make sure the -X switch table is empty
3161 X_Switches.Set_Last (0);
3163 -- Get the command line arguments
3165 Scan_Args : for Next_Arg in 1 .. Argument_Count loop
3166 Scan_Arg (Argument (Next_Arg));
3169 -- Fail if command line ended with "-P
"
3171 if Project_File_Name_Expected then
3172 Osint.Fail ("project file name missing after
-P
");
3174 -- Or if it ended with "-o
"
3176 elsif Output_File_Name_Expected then
3177 Osint.Fail ("output file name missing after
-o
");
3180 -- If no project file was specified, display the usage and fail
3182 if Project_File_Name = null then
3184 Exit_Program (E_Success);
3187 -- To be able of finding libgnat.a in MLib.Tgt, we need to have the
3188 -- default search dirs established in Osint.
3190 Osint.Add_Default_Search_Dirs;
3193 -----------------------------------
3194 -- Is_Included_In_Global_Archive --
3195 -----------------------------------
3197 function Is_Included_In_Global_Archive
3198 (Object_Name : Name_Id;
3199 Project : Project_Id) return Boolean
3201 Data : Project_Data := Projects.Table (Project);
3202 Source : Other_Source_Id;
3205 while Data.Extended_By /= No_Project loop
3206 Data := Projects.Table (Data.Extended_By);
3207 Source := Data.First_Other_Source;
3209 while Source /= No_Other_Source loop
3210 if Other_Sources.Table (Source).Object_Name = Object_Name then
3213 Source := Other_Sources.Table (Source).Next;
3219 end Is_Included_In_Global_Archive;
3221 ----------------------
3222 -- Link_Executables --
3223 ----------------------
3225 procedure Link_Executables is
3226 Data : constant Project_Data := Projects.Table (Main_Project);
3228 Mains_Specified : constant Boolean := Mains.Number_Of_Mains /= 0;
3229 -- True if main sources were specified on the command line
3231 Object_Dir : constant String := Get_Name_String (Data.Object_Directory);
3232 -- Path of the object directory of the main project
3234 Source_Id : Other_Source_Id;
3235 Source : Other_Source;
3238 Linker_Name : String_Access;
3239 Linker_Path : String_Access;
3240 -- The linker name and path, when linking is not done by gnatlink
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
3247 procedure Add_C_Plus_Plus_Link_For_Gnatmake;
3248 -- Add the --LINK= switch for gnatlink, depending on the C++ compiler
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.
3254 procedure Choose_C_Plus_Plus_Link_Process;
3255 -- If the C++ compiler is not g++, create the correct script to link
3257 procedure Link_Foreign
3260 Source : Other_Source);
3261 -- Link a non-Ada main, when there is no Ada code
3263 ---------------------------------------
3264 -- Add_C_Plus_Plus_Link_For_Gnatmake --
3265 ---------------------------------------
3267 procedure Add_C_Plus_Plus_Link_For_Gnatmake is
3269 if Compiler_Is_Gcc (C_Plus_Plus_Language_Index) then
3271 ("--LINK=" & Compiler_Names (C_Plus_Plus_Language_Index).all,
3277 Object_Dir
& Directory_Separator
&
3281 end Add_C_Plus_Plus_Link_For_Gnatmake
;
3283 -----------------------
3284 -- Check_Time_Stamps --
3285 -----------------------
3287 procedure Check_Time_Stamps
(Exec_Time_Stamp
: Time_Stamp_Type
) is
3288 Prj_Data
: Project_Data
;
3291 for Prj
in 1 .. Projects
.Last
loop
3292 Prj_Data
:= Projects
.Table
(Prj
);
3294 -- There is an archive only in project
3295 -- files with sources other than Ada
3298 if Data
.Other_Sources_Present
then
3300 Archive_Path
: constant String :=
3302 (Prj_Data
.Object_Directory
) &
3303 Directory_Separator
&
3305 Get_Name_String
(Prj_Data
.Name
) &
3307 Archive_TS
: Time_Stamp_Type
;
3310 Add_Str_To_Name_Buffer
3312 Archive_TS
:= File_Stamp
(Name_Find
);
3314 -- If the archive is later than the
3315 -- executable, we need to relink.
3317 if Archive_TS
/= Empty_Time_Stamp
3319 Exec_Time_Stamp
< Archive_TS
3321 Need_To_Relink
:= True;
3323 if Verbose_Mode
then
3325 Write_Str
(Archive_Path
);
3326 Write_Str
(" has time stamp ");
3327 Write_Str
("later than ");
3328 Write_Line
("executable");
3336 end Check_Time_Stamps
;
3338 -------------------------------------
3339 -- Choose_C_Plus_Plus_Link_Process --
3340 -------------------------------------
3342 procedure Choose_C_Plus_Plus_Link_Process
is
3344 if Compiler_Names
(C_Plus_Plus_Language_Index
) = null then
3345 Get_Compiler
(C_Plus_Plus_Language_Index
);
3348 if not Compiler_Is_Gcc
(C_Plus_Plus_Language_Index
) then
3349 Change_Dir
(Object_Dir
);
3352 File
: Ada
.Text_IO
.File_Type
;
3356 Create
(File
, Out_File
, Cpp_Linker
);
3358 Put_Line
(File
, "#!/bin/sh");
3360 Put_Line
(File
, "LIBGCC=`gcc -print-libgcc-file-name`");
3363 Compiler_Names
(C_Plus_Plus_Language_Index
).all &
3367 Set_Executable
(Cpp_Linker
);
3370 end Choose_C_Plus_Plus_Link_Process
;
3376 procedure Link_Foreign
3379 Source
: Other_Source
)
3381 Executable_Name
: constant String :=
3384 (Project
=> Main_Project
,
3387 Ada_Main
=> False));
3388 -- File name of the executable
3390 Executable_Path
: constant String :=
3392 (Data
.Exec_Directory
) &
3393 Directory_Separator
&
3395 -- Path name of the executable
3397 Exec_Time_Stamp
: Time_Stamp_Type
;
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.
3404 if not Need_To_Relink
then
3406 -- Get the time stamp of the executable
3409 Add_Str_To_Name_Buffer
(Executable_Path
);
3410 Exec_Time_Stamp
:= File_Stamp
(Name_Find
);
3412 if Verbose_Mode
then
3413 Write_Str
(" Checking executable ");
3414 Write_Line
(Executable_Name
);
3417 -- If executable does not exist, we need to link
3419 if Exec_Time_Stamp
= Empty_Time_Stamp
then
3420 Need_To_Relink
:= True;
3422 if Verbose_Mode
then
3423 Write_Line
(" -> not found");
3426 -- Otherwise, get the time stamps of each archive. If one of
3427 -- them is found later than the executable, we need to relink.
3430 Check_Time_Stamps
(Exec_Time_Stamp
);
3433 -- If Need_To_Relink is False, we are done
3435 if Verbose_Mode
and (not Need_To_Relink
) then
3436 Write_Line
(" -> up to date");
3442 if Need_To_Relink
then
3447 -- Specify the executable path name
3449 Add_Argument
(Dash_o
, True);
3451 (Get_Name_String
(Data
.Exec_Directory
) &
3452 Directory_Separator
&
3455 (Project
=> Main_Project
,
3458 Ada_Main
=> False)),
3461 -- Specify the object file of the main source
3464 (Object_Dir
& Directory_Separator
&
3465 Get_Name_String
(Source
.Object_Name
),
3468 -- Add all the archives, in a correct order
3470 Add_Archives
(For_Gnatmake
=> False);
3472 -- Add the switches specified in package Linker of
3473 -- the main project.
3478 Language
=> Source
.Language
,
3479 File_Name
=> Main_Id
);
3481 -- Add the switches specified in attribute
3482 -- Linker_Options of packages Linker.
3484 if Link_Options_Switches
= null then
3485 Link_Options_Switches
:=
3487 (Linker_Options_Switches (Main_Project));
3490 Add_Arguments (Link_Options_Switches.all, True);
3492 -- Add the linking options specified on the
3495 for Arg in 1 .. Linker_Options.Last loop
3496 Add_Argument (Linker_Options.Table (Arg), True);
3499 -- If there are shared libraries and the run path
3500 -- option is supported, add the run path switch.
3502 if Lib_Path.Last > 0 then
3505 String (Lib_Path.Table (1 .. Lib_Path.Last)),
3509 -- And invoke the linker
3511 Display_Command (Linker_Name.all, Linker_Path);
3514 Arguments (1 .. Last_Argument),
3518 Report_Error ("could not link ", Main);
3523 -- Start of processing of Link_Executables
3526 -- If no mains specified, get mains from attribute Main, if it exists
3528 if not Mains_Specified then
3530 Element_Id : String_List_Id := Data.Mains;
3531 Element : String_Element;
3534 while Element_Id /= Nil_String loop
3535 Element := String_Elements.Table (Element_Id);
3537 if Element.Value /= No_Name then
3538 Mains.Add_Main (Get_Name_String (Element.Value));
3541 Element_Id := Element.Next;
3546 if Mains.Number_Of_Mains = 0 then
3548 -- If the attribute Main is an empty list or not specified,
3549 -- there is nothing to do.
3551 if Verbose_Mode then
3552 Write_Line ("No main to link");
3557 -- Check if -o was used for several mains
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");
3563 -- Check how we are going to do the link
3565 if not Data.Other_Sources_Present then
3567 -- Only Ada sources in the main project, and even maybe not
3569 if not Data.Languages (Ada_Language_Index) then
3571 -- Fail if the main project has no source of any language
3575 Get_Name_String (Data.Name),
3576 """ has no sources, so no main can be linked");
3579 -- Only Ada sources in the main project, call gnatmake directly
3583 -- Choose correct linker if there is C++ code in other projects
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);
3592 Compile_Link_With_Gnatmake (Mains_Specified);
3596 -- There are other language sources. First check if there are also
3599 if Data.Languages (Ada_Language_Index) then
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.
3605 -- Find the mains of the other languages and the Ada mains.
3608 Ada_Mains.Set_Last (0);
3609 Other_Mains.Set_Last (0);
3615 Main : constant String := Mains.Next_Main;
3619 exit when Main'Length = 0;
3621 -- Get the main file name
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;
3629 -- Check if it is a source of a language other than Ada
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;
3637 -- If it is not, put it in the list of Ada mains
3639 if Source_Id = No_Other_Source then
3640 Ada_Mains.Increment_Last;
3641 Ada_Mains.Table (Ada_Mains.Last) := new String'(Main
);
3643 -- Otherwise, put it in the list of other mains
3646 Other_Mains
.Increment_Last
;
3647 Other_Mains
.Table
(Other_Mains
.Last
) := Source
;
3652 -- If C++ is one of the other language, create the shell script
3655 if C_Plus_Plus_Is_Used
then
3656 Choose_C_Plus_Plus_Link_Process
;
3659 -- Call gnatmake with the necessary switches for each non-Ada
3660 -- main, if there are some.
3662 for Main
in 1 .. Other_Mains
.Last
loop
3664 Source
: constant Other_Source
:= Other_Mains
.Table
(Main
);
3669 -- Add -o if -o was specified
3671 if Output_File_Name
= null then
3672 Add_Argument
(Dash_o
, True);
3676 (Project
=> Main_Project
,
3677 Main
=> Other_Mains
.Table
(Main
).File_Name
,
3679 Ada_Main
=> False)),
3683 -- Call gnatmake with the -B switch
3685 Add_Argument
(Dash_B
, True);
3687 -- Add to the linking options the object file of the source
3689 Add_Argument
(Dash_largs
, Verbose_Mode
);
3691 (Get_Name_String
(Source
.Object_Name
), Verbose_Mode
);
3693 -- If C++ is one of the language, add the --LINK switch
3694 -- to the linking switches.
3696 if C_Plus_Plus_Is_Used
then
3697 Add_C_Plus_Plus_Link_For_Gnatmake
;
3700 -- Add -margs so that the following switches are for
3703 Add_Argument
(Dash_margs
, Verbose_Mode
);
3705 -- And link with gnatmake
3707 Compile_Link_With_Gnatmake
(Mains_Specified
=> False);
3711 -- If there are also Ada mains, call gnatmake for all these mains
3713 if Ada_Mains
.Last
/= 0 then
3716 -- Put all the Ada mains as the first arguments
3718 for Main
in 1 .. Ada_Mains
.Last
loop
3719 Add_Argument
(Ada_Mains
.Table
(Main
).all, True);
3722 -- If C++ is one of the languages, add the --LINK switch to
3723 -- the linking switches.
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
);
3731 -- And link with gnatmake
3733 Compile_Link_With_Gnatmake
(Mains_Specified
=> False);
3737 -- No Ada source in main project
3739 -- First, get the linker to invoke
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
);
3747 Get_Compiler
(C_Language_Index
);
3748 Linker_Name
:= Compiler_Names
(C_Language_Index
);
3749 Linker_Path
:= Compiler_Paths
(C_Language_Index
);
3756 -- Get each main, check if it is a source of the main project,
3757 -- and if it is, invoke the linker.
3761 Main
: constant String := Mains
.Next_Main
;
3764 exit when Main
'Length = 0;
3766 -- Get the file name of the main
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
;
3774 -- Check if it is a source of the main project file
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
;
3782 -- Report an error if it is not
3784 if Source_Id
= No_Other_Source
then
3786 (Main
, "is not a source of project ",
3787 Get_Name_String
(Data
.Name
));
3790 Link_Foreign
(Main
, Main_Id
, Source
);
3795 -- If no linking was done, report it, except in Quiet Output
3797 if (Verbose_Mode
or (not Quiet_Output
)) and (not Link_Done
) then
3798 Osint
.Write_Program_Name
;
3800 if Mains
.Number_Of_Mains
= 1 then
3802 -- If there is only one executable, report its name too
3808 Main
: constant String := Mains
.Next_Main
;
3812 Add_Str_To_Name_Buffer
(Main
);
3813 Main_Id
:= Name_Find
;
3817 (Project
=> Main_Project
,
3820 Ada_Main
=> False)));
3821 Write_Line
(""" up to date");
3825 Write_Line
(": all executables up to date");
3830 end Link_Executables
;
3836 procedure Report_Error
3842 -- If Keep_Going is True, output error message preceded by error header
3845 Total_Number_Of_Errors
:= Total_Number_Of_Errors
+ 1;
3846 Write_Str
(Error_Header
);
3852 -- Otherwise just fail
3855 Osint
.Fail
(S1
, S2
, S3
);
3859 -------------------------
3860 -- Report_Total_Errors --
3861 -------------------------
3863 procedure Report_Total_Errors
(Kind
: String) is
3865 if Total_Number_Of_Errors
/= 0 then
3866 if Total_Number_Of_Errors
= 1 then
3868 ("One ", Kind
, " error");
3872 ("Total of" & Total_Number_Of_Errors
'Img,
3873 ' ' & Kind
& " errors");
3876 end Report_Total_Errors
;
3882 procedure Scan_Arg
(Arg
: String) is
3884 pragma Assert
(Arg
'First = 1);
3886 if Arg
'Length = 0 then
3890 -- If preceding switch was -P, a project file name need to be
3891 -- specified, not a switch.
3893 if Project_File_Name_Expected
then
3894 if Arg
(1) = '-' then
3895 Osint
.Fail
("project file name missing after -P");
3897 Project_File_Name_Expected
:= False;
3898 Project_File_Name
:= new String'(Arg);
3901 -- If preceding switch was -o, an executable name need to be
3902 -- specified, not a switch.
3904 elsif Output_File_Name_Expected then
3905 if Arg (1) = '-' then
3906 Osint.Fail ("output file name missing after -o");
3908 Output_File_Name_Expected := False;
3909 Output_File_Name := new String'(Arg
);
3912 -- Set the processor/language for the following switches
3914 -- -cargs: Ada compiler arguments
3916 elsif Arg
= "-cargs" then
3917 Current_Language
:= Ada_Language_Index
;
3918 Current_Processor
:= Compiler
;
3920 elsif Arg
'Length > 7 and then Arg
(1 .. 7) = "-cargs:" then
3922 Add_Str_To_Name_Buffer
(Arg
(8 .. Arg
'Last));
3923 To_Lower
(Name_Buffer
(1 .. Name_Len
));
3926 Lang
: constant Name_Id
:= Name_Find
;
3928 Current_Language
:= Language_Indexes
.Get
(Lang
);
3930 if Current_Language
= No_Language_Index
then
3931 Add_Language_Name
(Lang
);
3932 Current_Language
:= Last_Language_Index
;
3935 Current_Processor
:= Compiler
;
3938 elsif Arg
= "-largs" then
3939 Current_Processor
:= Linker
;
3943 elsif Arg
= "-gargs" then
3944 Current_Processor
:= None
;
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.
3949 elsif Current_Processor
= Linker
and then Arg
= "-o" then
3951 ("switch -o not allowed within a -largs. Use -o directly.");
3953 -- If current processor is not gprmake directly, store the option in
3954 -- the appropriate table.
3956 elsif Current_Processor
/= None
then
3959 -- Switches start with '-'
3961 elsif Arg
(1) = '-' then
3963 Compile_Only
:= True;
3965 elsif Arg
= "-f" then
3966 Force_Compilations
:= True;
3968 elsif Arg
= "-h" then
3971 elsif Arg
= "-k" then
3974 elsif Arg
= "-o" then
3975 if Output_File_Name
/= null then
3976 Osint
.Fail
("cannot specify several -o switches");
3979 Output_File_Name_Expected
:= True;
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");
3986 elsif Arg
'Length = 2 then
3987 Project_File_Name_Expected
:= True;
3990 Project_File_Name
:= new String'(Arg (3 .. Arg'Last));
3993 elsif Arg = "-q" then
3994 Quiet_Output := True;
3996 elsif Arg = "-u" then
3997 Unique_Compile := True;
3998 Compile_Only := True;
4000 elsif Arg = "-v" then
4001 Verbose_Mode := True;
4004 elsif Arg'Length = 4 and then Arg (1 .. 3) = "-vP"
4005 and then Arg (4) in '0' .. '2'
4009 Current_Verbosity := Prj.Default;
4011 Current_Verbosity := Prj.Medium;
4013 Current_Verbosity := Prj.High;
4018 elsif Arg'Length >= 3 and then Arg (2) = 'X
'
4019 and then Is_External_Assignment (Arg)
4021 -- Is_External_Assignment has side effects when it returns True
4023 -- Record the -X switch, so that they can be passed to gnatmake,
4024 -- if gnatmake is called.
4026 X_Switches.Increment_Last;
4027 X_Switches.Table (X_Switches.Last) := new String'(Arg
);
4030 Osint
.Fail
("illegal option """, Arg
, """");
4034 -- Not a switch: must be a main
4036 Mains
.Add_Main
(Arg
);
4044 function Strip_CR_LF
(Text
: String) return String is
4045 To
: String (1 .. Text
'Length);
4046 Index_To
: Natural := 0;
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
);
4056 return To
(1 .. Index_To
);
4065 if not Usage_Output
then
4066 Usage_Output
:= True;
4069 Write_Str
("Usage: ");
4070 Osint
.Write_Program_Name
;
4071 Write_Str
(" -P<project file> [opts] [name] {");
4073 for Lang
in First_Language_Indexes
loop
4074 Write_Str
("[-cargs:lang opts] ");
4077 Write_Str
("[-largs opts] [-gargs opts]}");
4080 Write_Str
(" name is zero or more file names");
4086 Write_Str
("gprmake switches:");
4091 Write_Str
(" -c Compile only");
4096 Write_Str
(" -f Force recompilations");
4101 Write_Str
(" -k Keep going after compilation errors");
4106 Write_Str
(" -o name Choose an alternate executable name");
4111 Write_Str
(" -Pproj Use GNAT Project File proj");
4116 Write_Str
(" -q Be quiet/terse");
4122 (" -u Unique compilation. Only compile the given files");
4127 Write_Str
(" -v Verbose output");
4132 Write_Str
(" -vPx Specify verbosity when parsing Project Files");
4137 Write_Str
(" -Xnm=val Specify an external reference for " &
4144 Write_Line
(" -cargs opts opts are passed to the Ada compiler");
4146 -- Line for -cargs:lang
4148 Write_Line
(" -cargs:<lang> opts");
4149 Write_Line
(" opts are passed to the compiler " &
4150 "for language < lang > ");
4154 Write_Str
(" -largs opts opts are passed to the linker");
4159 Write_Str
(" -gargs opts opts directly interpreted by gprmake");
4167 Makeutl
.Do_Fail
:= Report_Error
'Access;