1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2011, 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 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
27 with ALI.Util; use ALI.Util;
32 with Fname; use Fname;
33 with Fname.SF; use Fname.SF;
34 with Fname.UF; use Fname.UF;
35 with Gnatvsn; use Gnatvsn;
36 with Hostparm; use Hostparm;
38 with Makeutl; use Makeutl;
41 with MLib.Tgt; use MLib.Tgt;
43 with Namet; use Namet;
45 with Osint.M; use Osint.M;
46 with Osint; use Osint;
47 with Output; use Output;
52 with Prj.Tree; use Prj.Tree;
56 with Snames; use Snames;
58 pragma Warnings (Off);
62 with Switch; use Switch;
63 with Switch.M; use Switch.M;
64 with Targparm; use Targparm;
67 with Types; use Types;
69 with Ada.Exceptions; use Ada.Exceptions;
70 with Ada.Command_Line; use Ada.Command_Line;
72 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
73 with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables;
74 with GNAT.Case_Util; use GNAT.Case_Util;
75 with GNAT.OS_Lib; use GNAT.OS_Lib;
80 -- Make control characters visible
82 Standard_Library_Package_Body_Name : constant String := "s-stalib.adb";
83 -- Every program depends on this package, that must then be checked,
84 -- especially when -f and -a are used.
86 procedure Kill (Pid : Process_Id; Sig_Num : Integer; Close : Integer);
87 pragma Import (C, Kill, "__gnat_kill");
88 -- Called by Sigint_Intercepted to kill all spawned compilation processes
90 type Sigint_Handler is access procedure;
91 pragma Convention (C, Sigint_Handler);
93 procedure Install_Int_Handler (Handler : Sigint_Handler);
94 pragma Import (C, Install_Int_Handler, "__gnat_install_int_handler");
95 -- Called by Gnatmake to install the SIGINT handler below
97 procedure Sigint_Intercepted;
98 pragma Convention (C, Sigint_Intercepted);
99 -- Called when the program is interrupted by Ctrl-C to delete the
100 -- temporary mapping files and configuration pragmas files.
102 No_Mapping_File : constant Natural := 0;
104 type Compilation_Data is record
106 Full_Source_File : File_Name_Type;
107 Lib_File : File_Name_Type;
108 Source_Unit : Unit_Name_Type;
109 Full_Lib_File : File_Name_Type;
110 Lib_File_Attr : aliased File_Attributes;
111 Mapping_File : Natural := No_Mapping_File;
112 Project : Project_Id := No_Project;
114 -- Data recorded for each compilation process spawned
116 No_Compilation_Data : constant Compilation_Data :=
117 (Invalid_Pid, No_File, No_File, No_Unit_Name, No_File, Unknown_Attributes,
118 No_Mapping_File, No_Project);
120 type Comp_Data_Arr is array (Positive range <>) of Compilation_Data;
121 type Comp_Data_Ptr is access Comp_Data_Arr;
122 Running_Compile : Comp_Data_Ptr;
123 -- Used to save information about outstanding compilations
125 Outstanding_Compiles : Natural := 0;
126 -- Current number of outstanding compiles
128 -------------------------
129 -- Note on terminology --
130 -------------------------
132 -- In this program, we use the phrase "termination" of a file name to refer
133 -- to the suffix that appears after the unit name portion. Very often this
134 -- is simply the extension, but in some cases, the sequence may be more
135 -- complex, for example in main.1.ada, the termination in this name is
136 -- ".1.ada" and in main_.ada the termination is "_.ada".
138 procedure Insert_Project_Sources
139 (The_Project : Project_Id;
140 All_Projects : Boolean;
142 -- If Into_Q is True, insert all sources of the project file(s) that are
143 -- not already marked into the Q. If Into_Q is False, call Osint.Add_File
144 -- for the first source, then insert all other sources that are not already
145 -- marked into the Q. If All_Projects is True, all sources of all projects
146 -- are concerned; otherwise, only sources of The_Project are concerned,
147 -- including, if The_Project is an extending project, sources inherited
148 -- from projects being extended.
150 Unique_Compile : Boolean := False;
151 -- Set to True if -u or -U or a project file with no main is used
153 Unique_Compile_All_Projects : Boolean := False;
154 -- Set to True if -U is used
156 Must_Compile : Boolean := False;
157 -- True if gnatmake is invoked with -f -u and one or several mains on the
160 Project_Tree : constant Project_Tree_Ref :=
161 new Project_Tree_Data (Is_Root_Tree => True);
164 Main_On_Command_Line : Boolean := False;
165 -- True if gnatmake is invoked with one or several mains on the command
168 RTS_Specified : String_Access := null;
169 -- Used to detect multiple --RTS= switches
171 N_M_Switch : Natural := 0;
172 -- Used to count -mxxx switches that can affect multilib
174 -- The 3 following packages are used to store gcc, gnatbind and gnatlink
175 -- switches found in the project files.
177 package Gcc_Switches is new Table.Table (
178 Table_Component_Type => String_Access,
179 Table_Index_Type => Integer,
180 Table_Low_Bound => 1,
182 Table_Increment => 100,
183 Table_Name => "Make.Gcc_Switches");
185 package Binder_Switches is new Table.Table (
186 Table_Component_Type => String_Access,
187 Table_Index_Type => Integer,
188 Table_Low_Bound => 1,
190 Table_Increment => 100,
191 Table_Name => "Make.Binder_Switches");
193 package Linker_Switches is new Table.Table (
194 Table_Component_Type => String_Access,
195 Table_Index_Type => Integer,
196 Table_Low_Bound => 1,
198 Table_Increment => 100,
199 Table_Name => "Make.Linker_Switches");
201 -- The following instantiations and variables are necessary to save what
202 -- is found on the command line, in case there is a project file specified.
204 package Saved_Gcc_Switches is new Table.Table (
205 Table_Component_Type => String_Access,
206 Table_Index_Type => Integer,
207 Table_Low_Bound => 1,
209 Table_Increment => 100,
210 Table_Name => "Make.Saved_Gcc_Switches");
212 package Saved_Binder_Switches is new Table.Table (
213 Table_Component_Type => String_Access,
214 Table_Index_Type => Integer,
215 Table_Low_Bound => 1,
217 Table_Increment => 100,
218 Table_Name => "Make.Saved_Binder_Switches");
220 package Saved_Linker_Switches is new Table.Table
221 (Table_Component_Type => String_Access,
222 Table_Index_Type => Integer,
223 Table_Low_Bound => 1,
225 Table_Increment => 100,
226 Table_Name => "Make.Saved_Linker_Switches");
228 package Switches_To_Check is new Table.Table (
229 Table_Component_Type => String_Access,
230 Table_Index_Type => Integer,
231 Table_Low_Bound => 1,
233 Table_Increment => 100,
234 Table_Name => "Make.Switches_To_Check");
236 package Library_Paths 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 => "Make.Library_Paths");
244 package Failed_Links is new Table.Table (
245 Table_Component_Type => File_Name_Type,
246 Table_Index_Type => Integer,
247 Table_Low_Bound => 1,
249 Table_Increment => 100,
250 Table_Name => "Make.Failed_Links");
252 package Successful_Links is new Table.Table (
253 Table_Component_Type => File_Name_Type,
254 Table_Index_Type => Integer,
255 Table_Low_Bound => 1,
257 Table_Increment => 100,
258 Table_Name => "Make.Successful_Links");
260 package Library_Projs is new Table.Table (
261 Table_Component_Type => Project_Id,
262 Table_Index_Type => Integer,
263 Table_Low_Bound => 1,
265 Table_Increment => 100,
266 Table_Name => "Make.Library_Projs");
268 -- Two variables to keep the last binder and linker switch index in tables
269 -- Binder_Switches and Linker_Switches, before adding switches from the
270 -- project file (if any) and switches from the command line (if any).
272 Last_Binder_Switch : Integer := 0;
273 Last_Linker_Switch : Integer := 0;
275 Normalized_Switches : Argument_List_Access := new Argument_List (1 .. 10);
276 Last_Norm_Switch : Natural := 0;
278 Saved_Maximum_Processes : Natural := 0;
280 Gnatmake_Switch_Found : Boolean;
281 -- Set by Scan_Make_Arg. True when the switch is a gnatmake switch.
282 -- Tested by Add_Switches when switches in package Builder must all be
283 -- gnatmake switches.
285 Switch_May_Be_Passed_To_The_Compiler : Boolean;
286 -- Set by Add_Switches and Switches_Of. True when unrecognized switches
287 -- are passed to the Ada compiler.
289 type Arg_List_Ref is access Argument_List;
290 The_Saved_Gcc_Switches : Arg_List_Ref;
292 Project_File_Name : String_Access := null;
293 -- The path name of the main project file, if any
295 Project_File_Name_Present : Boolean := False;
296 -- True when -P is used with a space between -P and the project file name
298 Current_Verbosity : Prj.Verbosity := Prj.Default;
299 -- Verbosity to parse the project files
301 Main_Project : Prj.Project_Id := No_Project;
302 -- The project id of the main project file, if any
304 Project_Of_Current_Object_Directory : Project_Id := No_Project;
305 -- The object directory of the project for the last compilation. Avoid
306 -- calling Change_Dir if the current working directory is already this
309 Map_File : String_Access := null;
310 -- Value of switch --create-map-file
312 -- Packages of project files where unknown attributes are errors
314 Naming_String : aliased String := "naming";
315 Builder_String : aliased String := "builder";
316 Compiler_String : aliased String := "compiler";
317 Binder_String : aliased String := "binder";
318 Linker_String : aliased String := "linker";
320 Gnatmake_Packages : aliased String_List :=
321 (Naming_String 'Access,
322 Builder_String 'Access,
323 Compiler_String 'Access,
324 Binder_String 'Access,
325 Linker_String 'Access);
327 Packages_To_Check_By_Gnatmake : constant String_List_Access :=
328 Gnatmake_Packages'Access;
330 procedure Add_Library_Search_Dir
332 On_Command_Line : Boolean);
333 -- Call Add_Lib_Search_Dir with an absolute directory path. If Path is
334 -- relative path, when On_Command_Line is True, it is relative to the
335 -- current working directory. When On_Command_Line is False, it is relative
336 -- to the project directory of the main project.
338 procedure Add_Source_Search_Dir
340 On_Command_Line : Boolean);
341 -- Call Add_Src_Search_Dir with an absolute directory path. If Path is a
342 -- relative path, when On_Command_Line is True, it is relative to the
343 -- current working directory. When On_Command_Line is False, it is relative
344 -- to the project directory of the main project.
346 procedure Add_Source_Dir (N : String);
347 -- Call Add_Src_Search_Dir (output one line when in verbose mode)
349 procedure Add_Source_Directories is
350 new Prj.Env.For_All_Source_Dirs (Action => Add_Source_Dir);
352 procedure Add_Object_Dir (N : String);
353 -- Call Add_Lib_Search_Dir (output one line when in verbose mode)
355 procedure Add_Object_Directories is
356 new Prj.Env.For_All_Object_Dirs (Action => Add_Object_Dir);
358 procedure Change_To_Object_Directory (Project : Project_Id);
359 -- Change to the object directory of project Project, if this is not
360 -- already the current working directory.
362 type Bad_Compilation_Info is record
363 File : File_Name_Type;
364 Unit : Unit_Name_Type;
367 -- File is the name of the file for which a compilation failed. Unit is for
368 -- gnatdist use in order to easily get the unit name of a file when its
369 -- name is krunched or declared in gnat.adc. Found is False if the
370 -- compilation failed because the file could not be found.
372 package Bad_Compilation is new Table.Table (
373 Table_Component_Type => Bad_Compilation_Info,
374 Table_Index_Type => Natural,
375 Table_Low_Bound => 1,
377 Table_Increment => 100,
378 Table_Name => "Make.Bad_Compilation");
379 -- Full name of all the source files for which compilation fails
381 Do_Compile_Step : Boolean := True;
382 Do_Bind_Step : Boolean := True;
383 Do_Link_Step : Boolean := True;
384 -- Flags to indicate what step should be executed. Can be set to False
385 -- with the switches -c, -b and -l. These flags are reset to True for
386 -- each invocation of procedure Gnatmake.
388 Do_Codepeer_Globalize_Step : Boolean := False;
389 -- Flag to indicate whether the CodePeer globalizer should be called
391 Shared_String : aliased String := "-shared";
392 Force_Elab_Flags_String : aliased String := "-F";
394 No_Shared_Switch : aliased Argument_List := (1 .. 0 => null);
395 Shared_Switch : aliased Argument_List := (1 => Shared_String'Access);
396 Bind_Shared : Argument_List_Access := No_Shared_Switch'Access;
397 -- Switch to added in front of gnatbind switches. By default no switch is
398 -- added. Switch "-shared" is added if there is a non-static Library
401 Shared_Libgcc : aliased String := "-shared-libgcc";
403 No_Shared_Libgcc_Switch : aliased Argument_List := (1 .. 0 => null);
404 Shared_Libgcc_Switch : aliased Argument_List :=
405 (1 => Shared_Libgcc'Access);
406 Link_With_Shared_Libgcc : Argument_List_Access :=
407 No_Shared_Libgcc_Switch'Access;
409 procedure Make_Failed (S : String);
410 -- Delete all temp files created by Gnatmake and call Osint.Fail, with the
411 -- parameter S (see osint.ads). This is called from the Prj hierarchy and
412 -- the MLib hierarchy.
414 --------------------------
415 -- Obsolete Executables --
416 --------------------------
418 Executable_Obsolete : Boolean := False;
419 -- Executable_Obsolete is initially set to False for each executable,
420 -- and is set to True whenever one of the source of the executable is
421 -- compiled, or has already been compiled for another executable.
423 Max_Header : constant := 200;
424 -- This needs a proper comment, it used to say "arbitrary"
425 -- that's not an adequate comment ???
427 type Header_Num is range 1 .. Max_Header;
428 -- Header_Num for the hash table Obsoleted below
430 function Hash (F : File_Name_Type) return Header_Num;
431 -- Hash function for the hash table Obsoleted below
433 package Obsoleted is new System.HTable.Simple_HTable
434 (Header_Num => Header_Num,
437 Key => File_Name_Type,
440 -- A hash table to keep all files that have been compiled, to detect
441 -- if an executable is up to date or not.
443 procedure Enter_Into_Obsoleted (F : File_Name_Type);
444 -- Enter a file name, without directory information, into the hash table
447 function Is_In_Obsoleted (F : File_Name_Type) return Boolean;
448 -- Check if a file name, without directory information, has already been
449 -- entered into the hash table Obsoleted.
451 type Dependency is record
452 This : File_Name_Type;
453 Depends_On : File_Name_Type;
455 -- Components of table Dependencies below
457 package Dependencies is new Table.Table (
458 Table_Component_Type => Dependency,
459 Table_Index_Type => Integer,
460 Table_Low_Bound => 1,
462 Table_Increment => 100,
463 Table_Name => "Make.Dependencies");
464 -- A table to keep dependencies, to be able to decide if an executable
465 -- is obsolete. More explanation needed ???
467 -- procedure Add_Dependency (S : File_Name_Type; On : File_Name_Type);
468 -- -- Add one entry in table Dependencies
470 ----------------------------
471 -- Arguments and Switches --
472 ----------------------------
474 Arguments : Argument_List_Access;
475 -- Used to gather the arguments for invocation of the compiler
477 Last_Argument : Natural := 0;
478 -- Last index of arguments in Arguments above
480 Arguments_Project : Project_Id;
481 -- Project id, if any, of the source to be compiled
483 Arguments_Path_Name : Path_Name_Type;
484 -- Full path of the source to be compiled, when Arguments_Project is not
487 Dummy_Switch : constant String_Access := new String'("- ");
488 -- Used to initialized Prev_Switch in procedure Check
490 procedure Add_Arguments (Args : Argument_List);
491 -- Add arguments to global variable Arguments, increasing its size
492 -- if necessary and adjusting Last_Argument.
494 function Configuration_Pragmas_Switch
495 (For_Project : Project_Id) return Argument_List;
496 -- Return an argument list of one element, if there is a configuration
497 -- pragmas file to be specified for For_Project,
498 -- otherwise return an empty argument list.
504 procedure List_Depend;
505 -- Prints to standard output the list of object dependencies. This list
506 -- can be used directly in a Makefile. A call to Compile_Sources must
507 -- precede the call to List_Depend. Also because this routine uses the
508 -- ALI files that were originally loaded and scanned by Compile_Sources,
509 -- no additional ALI files should be scanned between the two calls (i.e.
510 -- between the call to Compile_Sources and List_Depend.)
512 procedure List_Bad_Compilations;
513 -- Prints out the list of all files for which the compilation failed
515 Usage_Needed : Boolean := True;
516 -- Flag used to make sure Makeusg is call at most once
519 -- Call Makeusg, if Usage_Needed is True.
520 -- Set Usage_Needed to False.
522 procedure Debug_Msg (S : String; N : Name_Id);
523 procedure Debug_Msg (S : String; N : File_Name_Type);
524 procedure Debug_Msg (S : String; N : Unit_Name_Type);
525 -- If Debug.Debug_Flag_W is set outputs string S followed by name N
527 procedure Recursive_Compute_Depth (Project : Project_Id);
528 -- Compute depth of Project and of the projects it depends on
530 -----------------------
531 -- Gnatmake Routines --
532 -----------------------
534 subtype Lib_Mark_Type is Byte;
535 -- Used in Mark_Directory
537 Ada_Lib_Dir : constant Lib_Mark_Type := 1;
538 -- Used to mark a directory as a GNAT lib dir
540 -- Note that the notion of GNAT lib dir is no longer used. The code related
541 -- to it has not been removed to give an idea on how to use the directory
542 -- prefix marking mechanism.
544 -- An Ada library directory is a directory containing ali and object files
545 -- but no source files for the bodies (the specs can be in the same or some
546 -- other directory). These directories are specified in the Gnatmake
547 -- command line with the switch "-Adir" (to specify the spec location -Idir
548 -- cab be used). Gnatmake skips the missing sources whose ali are in Ada
549 -- library directories. For an explanation of why Gnatmake behaves that
550 -- way, see the spec of Make.Compile_Sources. The directory lookup penalty
551 -- is incurred every single time this routine is called.
553 procedure Check_Steps;
554 -- Check what steps (Compile, Bind, Link) must be executed.
555 -- Set the step flags accordingly.
557 function In_Ada_Lib_Dir (File : File_Name_Type) return Boolean;
558 -- Get directory prefix of this file and get lib mark stored in name
559 -- table for this directory. Then check if an Ada lib mark has been set.
561 procedure Mark_Directory
563 Mark : Lib_Mark_Type;
564 On_Command_Line : Boolean);
565 -- Store the absolute path from Dir in name table and set lib mark as name
566 -- info to identify Ada libraries.
568 -- If Dir is a relative path, when On_Command_Line is True, it is relative
569 -- to the current working directory; when On_Command_Line is False, it is
570 -- relative to the project directory of the main project.
572 Output_Is_Object : Boolean := True;
573 -- Set to False when using a switch -S for the compiler
575 procedure Check_For_S_Switch;
576 -- Set Output_Is_Object to False when the -S switch is used for the
580 (Source_File : File_Name_Type;
581 Project : Project_Id;
582 In_Package : Package_Id;
583 Allow_ALI : Boolean) return Variable_Value;
584 -- Return the switches for the source file in the specified package of a
585 -- project file. If the Source_File ends with a standard GNAT extension
586 -- (".ads" or ".adb"), try first the full name, then the name without the
587 -- extension, then, if Allow_ALI is True, the name with the extension
588 -- ".ali". If there is no switches for either names, try first Switches
589 -- (others) then the default switches for Ada. If all failed, return
590 -- No_Variable_Value.
592 function Is_In_Object_Directory
593 (Source_File : File_Name_Type;
594 Full_Lib_File : File_Name_Type) return Boolean;
595 -- Check if, when using a project file, the ALI file is in the project
596 -- directory of the ultimate extending project. If it is not, we ignore
597 -- the fact that this ALI file is read-only.
599 procedure Process_Multilib (Env : in out Prj.Tree.Environment);
600 -- Add appropriate --RTS argument to handle multilib
602 ----------------------------------------------------
603 -- Compiler, Binder & Linker Data and Subprograms --
604 ----------------------------------------------------
606 Gcc : String_Access := Program_Name ("gcc", "gnatmake");
607 Gnatbind : String_Access := Program_Name ("gnatbind", "gnatmake");
608 Gnatlink : String_Access := Program_Name ("gnatlink", "gnatmake");
609 -- Default compiler, binder, linker programs
611 Globalizer : constant String := "codepeer_globalizer";
612 -- CodePeer globalizer executable name
614 Saved_Gcc : String_Access := null;
615 Saved_Gnatbind : String_Access := null;
616 Saved_Gnatlink : String_Access := null;
617 -- Given by the command line. Will be used, if non null
619 Gcc_Path : String_Access :=
620 GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all);
621 Gnatbind_Path : String_Access :=
622 GNAT.OS_Lib.Locate_Exec_On_Path (Gnatbind.all);
623 Gnatlink_Path : String_Access :=
624 GNAT.OS_Lib.Locate_Exec_On_Path (Gnatlink.all);
625 -- Path for compiler, binder, linker programs, defaulted now for gnatdist.
626 -- Changed later if overridden on command line.
628 Globalizer_Path : constant String_Access :=
629 GNAT.OS_Lib.Locate_Exec_On_Path (Globalizer);
630 -- Path for CodePeer globalizer
632 Comp_Flag : constant String_Access := new String'("-c");
633 Output_Flag : constant String_Access := new String'("-o");
634 Ada_Flag_1 : constant String_Access := new String'("-x");
635 Ada_Flag_2 : constant String_Access := new String'("ada");
636 No_gnat_adc : constant String_Access := new String'("-gnatA");
637 GNAT_Flag : constant String_Access := new String'("-gnatpg");
638 Do_Not_Check_Flag : constant String_Access := new String'("-x");
640 Object_Suffix : constant String := Get_Target_Object_Suffix.all;
642 Syntax_Only : Boolean := False;
643 -- Set to True when compiling with -gnats
645 Display_Executed_Programs : Boolean := True;
646 -- Set to True if name of commands should be output on stderr (or on stdout
647 -- if the Commands_To_Stdout flag was set by use of the -eS switch).
649 Output_File_Name_Seen : Boolean := False;
650 -- Set to True after having scanned the file_name for
651 -- switch "-o file_name"
653 Object_Directory_Seen : Boolean := False;
654 -- Set to True after having scanned the object directory for
655 -- switch "-D obj_dir".
657 Object_Directory_Path : String_Access := null;
658 -- The path name of the object directory, set with switch -D
660 type Make_Program_Type is (None, Compiler, Binder, Linker);
662 Program_Args : Make_Program_Type := None;
663 -- Used to indicate if we are scanning gnatmake, gcc, gnatbind, or gnatbind
664 -- options within the gnatmake command line. Used in Scan_Make_Arg only,
665 -- but must be global since value preserved from one call to another.
667 Temporary_Config_File : Boolean := False;
668 -- Set to True when there is a temporary config file used for a project
669 -- file, to avoid displaying the -gnatec switch for a temporary file.
671 procedure Add_Switches
672 (The_Package : Package_Id;
675 Program : Make_Program_Type;
676 Unknown_Switches_To_The_Compiler : Boolean := True;
677 Project_Node_Tree : Project_Node_Tree_Ref;
678 Env : in out Prj.Tree.Environment);
681 Program : Make_Program_Type;
682 Append_Switch : Boolean := True;
683 And_Save : Boolean := True);
686 Program : Make_Program_Type;
687 Append_Switch : Boolean := True;
688 And_Save : Boolean := True);
689 -- Make invokes one of three programs (the compiler, the binder or the
690 -- linker). For the sake of convenience, some program specific switches
691 -- can be passed directly on the gnatmake command line. This procedure
692 -- records these switches so that gnatmake can pass them to the right
693 -- program. S is the switch to be added at the end of the command line
694 -- for Program if Append_Switch is True. If Append_Switch is False S is
695 -- added at the beginning of the command line.
698 (Source_File : File_Name_Type;
700 Is_Main_Source : Boolean;
701 The_Args : Argument_List;
702 Lib_File : File_Name_Type;
703 Full_Lib_File : File_Name_Type;
704 Lib_File_Attr : access File_Attributes;
707 O_File : out File_Name_Type;
708 O_Stamp : out Time_Stamp_Type);
709 -- Determines whether the library file Lib_File is up-to-date or not. The
710 -- full name (with path information) of the object file corresponding to
711 -- Lib_File is returned in O_File. Its time stamp is saved in O_Stamp.
712 -- ALI is the ALI_Id corresponding to Lib_File. If Lib_File in not
713 -- up-to-date, then the corresponding source file needs to be recompiled.
714 -- In this case ALI = No_ALI_Id.
715 -- Full_Lib_File must be the result of calling Osint.Full_Lib_File_Name on
716 -- Lib_File. Precomputing it saves system calls. Lib_File_Attr is the
717 -- initialized attributes of that file, which is also used to save on
718 -- system calls (it can safely be initialized to Unknown_Attributes).
720 procedure Check_Linker_Options
721 (E_Stamp : Time_Stamp_Type;
722 O_File : out File_Name_Type;
723 O_Stamp : out Time_Stamp_Type);
724 -- Checks all linker options for linker files that are newer
725 -- than E_Stamp. If such objects are found, the youngest object
726 -- is returned in O_File and its stamp in O_Stamp.
728 -- If no obsolete linker files were found, the first missing
729 -- linker file is returned in O_File and O_Stamp is empty.
730 -- Otherwise O_File is No_File.
732 procedure Collect_Arguments
733 (Source_File : File_Name_Type;
734 Is_Main_Source : Boolean;
735 Args : Argument_List);
736 -- Collect all arguments for a source to be compiled, including those
737 -- that come from a project file.
739 procedure Display (Program : String; Args : Argument_List);
740 -- Displays Program followed by the arguments in Args if variable
741 -- Display_Executed_Programs is set. The lower bound of Args must be 1.
743 procedure Report_Compilation_Failed;
744 -- Delete all temporary files and fail graciously
750 type Temp_Path_Names is array (Positive range <>) of Path_Name_Type;
751 type Temp_Path_Ptr is access Temp_Path_Names;
753 type Free_File_Indexes is array (Positive range <>) of Positive;
754 type Free_Indexes_Ptr is access Free_File_Indexes;
756 type Project_Compilation_Data is record
757 Mapping_File_Names : Temp_Path_Ptr;
758 -- The name ids of the temporary mapping files used. This is indexed
759 -- on the maximum number of compilation processes we will be spawning
762 Last_Mapping_File_Names : Natural;
763 -- Index of the last mapping file created for this project
765 Free_Mapping_File_Indexes : Free_Indexes_Ptr;
766 -- Indexes in Mapping_File_Names of the mapping file names that can be
767 -- reused for subsequent compilations.
769 Last_Free_Indexes : Natural;
770 -- Number of mapping files that can be reused
772 -- Information necessary when compiling a project
774 type Project_Compilation_Access is access Project_Compilation_Data;
776 package Project_Compilation_Htable is new Simple_HTable
777 (Header_Num => Prj.Header_Num,
778 Element => Project_Compilation_Access,
784 Project_Compilation : Project_Compilation_Htable.Instance;
786 Gnatmake_Mapping_File : String_Access := null;
787 -- The path name of a mapping file specified by switch -C=
789 procedure Init_Mapping_File
790 (Project : Project_Id;
791 Data : in out Project_Compilation_Data;
792 File_Index : in out Natural);
793 -- Create a new temporary mapping file, and fill it with the project file
794 -- mappings, when using project file(s). The out parameter File_Index is
795 -- the index to the name of the file in the array The_Mapping_File_Names.
797 procedure Delete_Temp_Config_Files;
798 -- Delete all temporary config files. Must not be called if Debug_Flag_N
801 procedure Delete_All_Temp_Files;
802 -- Delete all temp files (config files, mapping files, path files), unless
803 -- Debug_Flag_N is True (in which case all temp files are left for user
806 -------------------------------------------------
807 -- Subprogram declarations moved from the spec --
808 -------------------------------------------------
810 procedure Bind (ALI_File : File_Name_Type; Args : Argument_List);
811 -- Binds ALI_File. Args are the arguments to pass to the binder.
812 -- Args must have a lower bound of 1.
814 procedure Display_Commands (Display : Boolean := True);
815 -- The default behavior of Make commands (Compile_Sources, Bind, Link)
816 -- is to display them on stderr. This behavior can be changed repeatedly
817 -- by invoking this procedure.
819 -- If a compilation, bind or link failed one of the following 3 exceptions
820 -- is raised. These need to be handled by the calling routines.
822 procedure Compile_Sources
823 (Main_Source : File_Name_Type;
824 Args : Argument_List;
825 First_Compiled_File : out File_Name_Type;
826 Most_Recent_Obj_File : out File_Name_Type;
827 Most_Recent_Obj_Stamp : out Time_Stamp_Type;
828 Main_Unit : out Boolean;
829 Compilation_Failures : out Natural;
830 Main_Index : Int := 0;
831 Check_Readonly_Files : Boolean := False;
832 Do_Not_Execute : Boolean := False;
833 Force_Compilations : Boolean := False;
834 Keep_Going : Boolean := False;
835 In_Place_Mode : Boolean := False;
836 Initialize_ALI_Data : Boolean := True;
837 Max_Process : Positive := 1);
838 -- Compile_Sources will recursively compile all the sources needed by
839 -- Main_Source. Before calling this routine make sure Namet has been
840 -- initialized. This routine can be called repeatedly with different
841 -- Main_Source file as long as all the source (-I flags), library
842 -- (-B flags) and ada library (-A flags) search paths between calls are
843 -- *exactly* the same. The default directory must also be the same.
845 -- Args contains the arguments to use during the compilations.
846 -- The lower bound of Args must be 1.
848 -- First_Compiled_File is set to the name of the first file that is
849 -- compiled or that needs to be compiled. This is set to No_Name if no
850 -- compilations were needed.
852 -- Most_Recent_Obj_File is set to the full name of the most recent
853 -- object file found when no compilations are needed, that is when
854 -- First_Compiled_File is set to No_Name. When First_Compiled_File
855 -- is set then Most_Recent_Obj_File is set to No_Name.
857 -- Most_Recent_Obj_Stamp is the time stamp of Most_Recent_Obj_File.
859 -- Main_Unit is set to True if Main_Source can be a main unit.
860 -- If Do_Not_Execute is False and First_Compiled_File /= No_Name
861 -- the value of Main_Unit is always False.
862 -- Is this used any more??? It is certainly not used by gnatmake???
864 -- Compilation_Failures is a count of compilation failures. This count
865 -- is used to extract compilation failure reports with Extract_Failure.
867 -- Main_Index, when not zero, is the index of the main unit in source
868 -- file Main_Source which is a multi-unit source.
869 -- Zero indicates that Main_Source is a single unit source file.
871 -- Check_Readonly_Files set it to True to compile source files
872 -- which library files are read-only. When compiling GNAT predefined
873 -- files the "-gnatg" flag is used.
875 -- Do_Not_Execute set it to True to find out the first source that
876 -- needs to be recompiled, but without recompiling it. This file is
877 -- saved in First_Compiled_File.
879 -- Force_Compilations forces all compilations no matter what but
880 -- recompiles read-only files only if Check_Readonly_Files
883 -- Keep_Going when True keep compiling even in the presence of
884 -- compilation errors.
886 -- In_Place_Mode when True save library/object files in their object
887 -- directory if they already exist; otherwise, in the source directory.
889 -- Initialize_ALI_Data set it to True when you want to initialize ALI
890 -- data-structures. This is what you should do most of the time.
891 -- (especially the first time around when you call this routine).
892 -- This parameter is set to False to preserve previously recorded
895 -- Max_Process is the maximum number of processes that should be spawned
896 -- to carry out compilations.
898 -- Flags in Package Opt Affecting Compile_Sources
899 -- -----------------------------------------------
901 -- Check_Object_Consistency set it to False to omit all consistency
902 -- checks between an .ali file and its corresponding object file.
903 -- When this flag is set to true, every time an .ali is read,
904 -- package Osint checks that the corresponding object file
905 -- exists and is more recent than the .ali.
907 -- Use of Name Table Info
908 -- ----------------------
910 -- All file names manipulated by Compile_Sources are entered into the
911 -- Names table. The Byte field of a source file is used to mark it.
913 -- Calling Compile_Sources Several Times
914 -- -------------------------------------
916 -- Upon return from Compile_Sources all the ALI data structures are left
917 -- intact for further browsing. HOWEVER upon entry to this routine ALI
918 -- data structures are re-initialized if parameter Initialize_ALI_Data
919 -- above is set to true. Typically this is what you want the first time
920 -- you call Compile_Sources. You should not load an ali file, call this
921 -- routine with flag Initialize_ALI_Data set to True and then expect
922 -- that ALI information to be around after the call. Note that the first
923 -- time you call Compile_Sources you better set Initialize_ALI_Data to
924 -- True unless you have called Initialize_ALI yourself.
926 -- Compile_Sources ALGORITHM : Compile_Sources (Main_Source)
927 -- -------------------------
929 -- 1. Insert Main_Source in a Queue (Q) and mark it.
931 -- 2. Let unit.adb be the file at the head of the Q. If unit.adb is
932 -- missing but its corresponding ali file is in an Ada library directory
933 -- (see below) then, remove unit.adb from the Q and goto step 4.
934 -- Otherwise, look at the files under the D (dependency) section of
935 -- unit.ali. If unit.ali does not exist or some of the time stamps do
936 -- not match, (re)compile unit.adb.
938 -- An Ada library directory is a directory containing Ada specs, ali
939 -- and object files but no source files for the bodies. An Ada library
940 -- directory is communicated to gnatmake by means of some switch so that
941 -- gnatmake can skip the sources whole ali are in that directory.
942 -- There are two reasons for skipping the sources in this case. Firstly,
943 -- Ada libraries typically come without full sources but binding and
944 -- linking against those libraries is still possible. Secondly, it would
945 -- be very wasteful for gnatmake to systematically check the consistency
946 -- of every external Ada library used in a program. The binder is
947 -- already in charge of catching any potential inconsistencies.
949 -- 3. Look into the W section of unit.ali and insert into the Q all
950 -- unmarked source files. Mark all files newly inserted in the Q.
951 -- Specifically, assuming that the W section looks like
953 -- W types%s types.adb types.ali
954 -- W unchecked_deallocation%s
955 -- W xref_tab%s xref_tab.adb xref_tab.ali
957 -- Then xref_tab.adb and types.adb are inserted in the Q if they are not
959 -- Note that there is no file listed under W unchecked_deallocation%s
960 -- so no generic body should ever be explicitly compiled (unless the
961 -- Main_Source at the start was a generic body).
963 -- 4. Repeat steps 2 and 3 above until the Q is empty
965 -- Note that the above algorithm works because the units withed in
966 -- subunits are transitively included in the W section (with section) of
967 -- the main unit. Likewise the withed units in a generic body needed
968 -- during a compilation are also transitively included in the W section
969 -- of the originally compiled file.
971 procedure Globalize (Success : out Boolean);
972 -- Call the CodePeer globalizer on all the project's object directories,
973 -- or on the current directory if no projects.
976 (Project_Node_Tree : out Project_Node_Tree_Ref;
977 Env : out Prj.Tree.Environment);
978 -- Performs default and package initialization. Therefore,
979 -- Compile_Sources can be called by an external unit.
982 (ALI_File : File_Name_Type;
983 Args : Argument_List;
984 Success : out Boolean);
985 -- Links ALI_File. Args are the arguments to pass to the linker.
986 -- Args must have a lower bound of 1. Success indicates if the link
989 procedure Scan_Make_Arg
990 (Env : in out Prj.Tree.Environment;
993 -- Scan make arguments. Argv is a single argument to be processed.
994 -- Project_Node_Tree will be used to initialize external references. It
995 -- must have been initialized.
1001 procedure Add_Arguments (Args : Argument_List) is
1003 if Arguments = null then
1004 Arguments := new Argument_List (1 .. Args'Length + 10);
1007 while Last_Argument + Args'Length > Arguments'Last loop
1009 New_Arguments : constant Argument_List_Access :=
1010 new Argument_List (1 .. Arguments'Last * 2);
1012 New_Arguments (1 .. Last_Argument) :=
1013 Arguments (1 .. Last_Argument);
1014 Arguments := New_Arguments;
1019 Arguments (Last_Argument + 1 .. Last_Argument + Args'Length) := Args;
1020 Last_Argument := Last_Argument + Args'Length;
1023 -- --------------------
1024 -- -- Add_Dependency --
1025 -- --------------------
1027 -- procedure Add_Dependency (S : File_Name_Type; On : File_Name_Type) is
1029 -- Dependencies.Increment_Last;
1030 -- Dependencies.Table (Dependencies.Last) := (S, On);
1031 -- end Add_Dependency;
1033 ----------------------------
1034 -- Add_Library_Search_Dir --
1035 ----------------------------
1037 procedure Add_Library_Search_Dir
1039 On_Command_Line : Boolean)
1042 if On_Command_Line then
1043 Add_Lib_Search_Dir (Normalize_Pathname (Path));
1046 Get_Name_String (Main_Project.Directory.Display_Name);
1048 (Normalize_Pathname (Path, Name_Buffer (1 .. Name_Len)));
1050 end Add_Library_Search_Dir;
1052 --------------------
1053 -- Add_Object_Dir --
1054 --------------------
1056 procedure Add_Object_Dir (N : String) is
1058 Add_Lib_Search_Dir (N);
1060 if Verbose_Mode then
1061 Write_Str ("Adding object directory """);
1068 --------------------
1069 -- Add_Source_Dir --
1070 --------------------
1072 procedure Add_Source_Dir (N : String) is
1074 Add_Src_Search_Dir (N);
1076 if Verbose_Mode then
1077 Write_Str ("Adding source directory """);
1084 ---------------------------
1085 -- Add_Source_Search_Dir --
1086 ---------------------------
1088 procedure Add_Source_Search_Dir
1090 On_Command_Line : Boolean)
1093 if On_Command_Line then
1094 Add_Src_Search_Dir (Normalize_Pathname (Path));
1097 Get_Name_String (Main_Project.Directory.Display_Name);
1099 (Normalize_Pathname (Path, Name_Buffer (1 .. Name_Len)));
1101 end Add_Source_Search_Dir;
1107 procedure Add_Switch
1109 Program : Make_Program_Type;
1110 Append_Switch : Boolean := True;
1111 And_Save : Boolean := True)
1114 with package T is new Table.Table (<>);
1115 procedure Generic_Position (New_Position : out Integer);
1116 -- Generic procedure that chooses a position for S in T at the
1117 -- beginning or the end, depending on the boolean Append_Switch.
1118 -- Calling this procedure may expand the table.
1120 ----------------------
1121 -- Generic_Position --
1122 ----------------------
1124 procedure Generic_Position (New_Position : out Integer) is
1128 if Append_Switch then
1129 New_Position := Integer (T.Last);
1131 for J in reverse T.Table_Index_Type'Succ (T.First) .. T.Last loop
1132 T.Table (J) := T.Table (T.Table_Index_Type'Pred (J));
1135 New_Position := Integer (T.First);
1137 end Generic_Position;
1139 procedure Gcc_Switches_Pos is new Generic_Position (Gcc_Switches);
1140 procedure Binder_Switches_Pos is new Generic_Position (Binder_Switches);
1141 procedure Linker_Switches_Pos is new Generic_Position (Linker_Switches);
1143 procedure Saved_Gcc_Switches_Pos is new
1144 Generic_Position (Saved_Gcc_Switches);
1146 procedure Saved_Binder_Switches_Pos is new
1147 Generic_Position (Saved_Binder_Switches);
1149 procedure Saved_Linker_Switches_Pos is new
1150 Generic_Position (Saved_Linker_Switches);
1152 New_Position : Integer;
1154 -- Start of processing for Add_Switch
1160 Saved_Gcc_Switches_Pos (New_Position);
1161 Saved_Gcc_Switches.Table (New_Position) := S;
1164 Saved_Binder_Switches_Pos (New_Position);
1165 Saved_Binder_Switches.Table (New_Position) := S;
1168 Saved_Linker_Switches_Pos (New_Position);
1169 Saved_Linker_Switches.Table (New_Position) := S;
1172 raise Program_Error;
1178 Gcc_Switches_Pos (New_Position);
1179 Gcc_Switches.Table (New_Position) := S;
1182 Binder_Switches_Pos (New_Position);
1183 Binder_Switches.Table (New_Position) := S;
1186 Linker_Switches_Pos (New_Position);
1187 Linker_Switches.Table (New_Position) := S;
1190 raise Program_Error;
1195 procedure Add_Switch
1197 Program : Make_Program_Type;
1198 Append_Switch : Boolean := True;
1199 And_Save : Boolean := True)
1202 Add_Switch (S => new String'(S),
1204 Append_Switch => Append_Switch,
1205 And_Save => And_Save);
1212 procedure Add_Switches
1213 (The_Package : Package_Id;
1216 Program : Make_Program_Type;
1217 Unknown_Switches_To_The_Compiler : Boolean := True;
1218 Project_Node_Tree : Project_Node_Tree_Ref;
1219 Env : in out Prj.Tree.Environment)
1221 Switches : Variable_Value;
1222 Switch_List : String_List_Id;
1223 Element : String_Element;
1226 Switch_May_Be_Passed_To_The_Compiler :=
1227 Unknown_Switches_To_The_Compiler;
1229 if File_Name'Length > 0 then
1231 Add_Str_To_Name_Buffer (File_Name);
1234 (Source_File => Name_Find,
1235 Project => Main_Project,
1236 In_Package => The_Package,
1237 Allow_ALI => Program = Binder or else Program = Linker);
1239 if Switches.Kind = List then
1240 Program_Args := Program;
1242 Switch_List := Switches.Values;
1243 while Switch_List /= Nil_String loop
1245 Project_Tree.Shared.String_Elements.Table (Switch_List);
1246 Get_Name_String (Element.Value);
1248 if Name_Len > 0 then
1250 Argv : constant String := Name_Buffer (1 .. Name_Len);
1251 -- We need a copy, because Name_Buffer may be modified
1254 if Verbose_Mode then
1255 Write_Str (" Adding ");
1259 Scan_Make_Arg (Env, Argv, And_Save => False);
1261 if not Gnatmake_Switch_Found
1262 and then not Switch_May_Be_Passed_To_The_Compiler
1266 """ is not a gnatmake switch. Consider moving " &
1267 "it to Global_Compilation_Switches.",
1270 Make_Failed ("*** illegal switch """ & Argv & """");
1275 Switch_List := Element.Next;
1285 procedure Bind (ALI_File : File_Name_Type; Args : Argument_List) is
1286 Bind_Args : Argument_List (1 .. Args'Last + 2);
1287 Bind_Last : Integer;
1291 pragma Assert (Args'First = 1);
1293 -- Optimize the simple case where the gnatbind command line looks like
1294 -- gnatbind -aO. -I- file.ali --into-> gnatbind file.adb
1297 and then Args (Args'First).all = "-aO" & Normalized_CWD
1298 and then Args (Args'Last).all = "-I-"
1299 and then ALI_File = Strip_Directory (ALI_File)
1301 Bind_Last := Args'First - 1;
1304 Bind_Last := Args'Last;
1305 Bind_Args (Args'Range) := Args;
1308 -- It is completely pointless to re-check source file time stamps. This
1309 -- has been done already by gnatmake
1311 Bind_Last := Bind_Last + 1;
1312 Bind_Args (Bind_Last) := Do_Not_Check_Flag;
1314 Get_Name_String (ALI_File);
1316 Bind_Last := Bind_Last + 1;
1317 Bind_Args (Bind_Last) := new String'(Name_Buffer (1 .. Name_Len));
1319 GNAT.OS_Lib.Normalize_Arguments (Bind_Args (Args'First .. Bind_Last));
1321 Display (Gnatbind.all, Bind_Args (Args'First .. Bind_Last));
1323 if Gnatbind_Path = null then
1324 Make_Failed ("error, unable to locate " & Gnatbind.all);
1328 (Gnatbind_Path.all, Bind_Args (Args'First .. Bind_Last), Success);
1331 Make_Failed ("*** bind failed.");
1335 --------------------------------
1336 -- Change_To_Object_Directory --
1337 --------------------------------
1339 procedure Change_To_Object_Directory (Project : Project_Id) is
1340 Object_Directory : Path_Name_Type;
1343 pragma Assert (Project /= No_Project);
1345 -- Nothing to do if the current working directory is already the correct
1346 -- object directory.
1348 if Project_Of_Current_Object_Directory /= Project then
1349 Project_Of_Current_Object_Directory := Project;
1350 Object_Directory := Project.Object_Directory.Display_Name;
1352 -- Set the working directory to the object directory of the actual
1355 if Verbose_Mode then
1356 Write_Str ("Changing to object directory of """);
1357 Write_Name (Project.Display_Name);
1358 Write_Str (""": """);
1359 Write_Name (Object_Directory);
1363 Change_Dir (Get_Name_String (Object_Directory));
1367 -- Fail if unable to change to the object directory
1369 when Directory_Error =>
1370 Make_Failed ("unable to change to object directory """ &
1372 (Project.Object_Directory.Display_Name) &
1374 Get_Name_String (Project.Display_Name));
1375 end Change_To_Object_Directory;
1382 (Source_File : File_Name_Type;
1384 Is_Main_Source : Boolean;
1385 The_Args : Argument_List;
1386 Lib_File : File_Name_Type;
1387 Full_Lib_File : File_Name_Type;
1388 Lib_File_Attr : access File_Attributes;
1389 Read_Only : Boolean;
1391 O_File : out File_Name_Type;
1392 O_Stamp : out Time_Stamp_Type)
1394 function First_New_Spec (A : ALI_Id) return File_Name_Type;
1395 -- Looks in the with table entries of A and returns the spec file name
1396 -- of the first withed unit (subprogram) for which no spec existed when
1397 -- A was generated but for which there exists one now, implying that A
1398 -- is now obsolete. If no such unit is found No_File is returned.
1399 -- Otherwise the spec file name of the unit is returned.
1401 -- **WARNING** in the event of Uname format modifications, one *MUST*
1402 -- make sure this function is also updated.
1404 -- Note: This function should really be in ali.adb and use Uname
1405 -- services, but this causes the whole compiler to be dragged along
1406 -- for gnatbind and gnatmake.
1408 --------------------
1409 -- First_New_Spec --
1410 --------------------
1412 function First_New_Spec (A : ALI_Id) return File_Name_Type is
1413 Spec_File_Name : File_Name_Type := No_File;
1415 function New_Spec (Uname : Unit_Name_Type) return Boolean;
1416 -- Uname is the name of the spec or body of some ada unit. This
1417 -- function returns True if the Uname is the name of a body which has
1418 -- a spec not mentioned in ALI file A. If True is returned
1419 -- Spec_File_Name above is set to the name of this spec file.
1425 function New_Spec (Uname : Unit_Name_Type) return Boolean is
1426 Spec_Name : Unit_Name_Type;
1427 File_Name : File_Name_Type;
1430 -- Test whether Uname is the name of a body unit (i.e. ends
1433 Get_Name_String (Uname);
1435 Assert (Name_Len > 2 and then Name_Buffer (Name_Len - 1) = '%');
1437 if Name_Buffer (Name_Len) /= 'b' then
1441 -- Convert unit name into spec name
1443 -- ??? this code seems dubious in presence of pragma
1444 -- Source_File_Name since there is no more direct relationship
1445 -- between unit name and file name.
1447 -- ??? Further, what about alternative subunit naming
1449 Name_Buffer (Name_Len) := 's';
1450 Spec_Name := Name_Find;
1451 File_Name := Get_File_Name (Spec_Name, Subunit => False);
1453 -- Look if File_Name is mentioned in A's sdep list.
1454 -- If not look if the file exists. If it does return True.
1457 ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep
1459 if Sdep.Table (D).Sfile = File_Name then
1464 if Full_Source_Name (File_Name) /= No_File then
1465 Spec_File_Name := File_Name;
1472 -- Start of processing for First_New_Spec
1476 ALIs.Table (A).First_Unit .. ALIs.Table (A).Last_Unit
1478 exit U_Chk when Units.Table (U).Utype = Is_Body_Only
1479 and then New_Spec (Units.Table (U).Uname);
1481 for W in Units.Table (U).First_With
1483 Units.Table (U).Last_With
1486 Withs.Table (W).Afile /= No_File
1487 and then New_Spec (Withs.Table (W).Uname);
1491 return Spec_File_Name;
1494 ---------------------------------
1495 -- Data declarations for Check --
1496 ---------------------------------
1498 Full_Obj_File : File_Name_Type;
1499 -- Full name of the object file corresponding to Lib_File
1501 Lib_Stamp : Time_Stamp_Type;
1502 -- Time stamp of the current ada library file
1504 Obj_Stamp : Time_Stamp_Type;
1505 -- Time stamp of the current object file
1507 Modified_Source : File_Name_Type;
1508 -- The first source in Lib_File whose current time stamp differs
1509 -- from that stored in Lib_File.
1511 New_Spec : File_Name_Type;
1512 -- If Lib_File contains in its W (with) section a body (for a
1513 -- subprogram) for which there exists a spec and the spec did not
1514 -- appear in the Sdep section of Lib_File, New_Spec contains the file
1515 -- name of this new spec.
1517 Source_Name : File_Name_Type;
1518 Text : Text_Buffer_Ptr;
1520 Prev_Switch : String_Access;
1521 -- Previous switch processed
1523 Arg : Arg_Id := Arg_Id'First;
1524 -- Current index in Args.Table for a given unit (init to stop warning)
1526 Switch_Found : Boolean;
1527 -- True if a given switch has been found
1529 ALI_Project : Project_Id;
1530 -- If the ALI file is in the object directory of a project, this is
1533 -- Start of processing for Check
1536 pragma Assert (Lib_File /= No_File);
1538 -- If ALI file is read-only, temporarily set Check_Object_Consistency to
1539 -- False. We don't care if the object file is not there (presumably a
1540 -- library will be used for linking.)
1544 Saved_Check_Object_Consistency : constant Boolean :=
1545 Check_Object_Consistency;
1547 Check_Object_Consistency := False;
1548 Text := Read_Library_Info_From_Full (Full_Lib_File, Lib_File_Attr);
1549 Check_Object_Consistency := Saved_Check_Object_Consistency;
1553 Text := Read_Library_Info_From_Full (Full_Lib_File, Lib_File_Attr);
1556 Full_Obj_File := Full_Object_File_Name;
1557 Lib_Stamp := Current_Library_File_Stamp;
1558 Obj_Stamp := Current_Object_File_Stamp;
1560 if Full_Lib_File = No_File then
1563 "being checked ...",
1565 Minimum_Verbosity => Opt.Medium);
1569 "being checked ...",
1571 Minimum_Verbosity => Opt.Medium);
1575 O_File := Full_Obj_File;
1576 O_Stamp := Obj_Stamp;
1579 if Full_Lib_File = No_File then
1580 Verbose_Msg (Lib_File, "missing.");
1582 elsif Obj_Stamp (Obj_Stamp'First) = ' ' then
1583 Verbose_Msg (Full_Obj_File, "missing.");
1587 (Full_Lib_File, "(" & String (Lib_Stamp) & ") newer than",
1588 Full_Obj_File, "(" & String (Obj_Stamp) & ")");
1592 ALI := Scan_ALI (Lib_File, Text, Ignore_ED => False, Err => True);
1595 if ALI = No_ALI_Id then
1596 Verbose_Msg (Full_Lib_File, "incorrectly formatted ALI file");
1599 elsif ALIs.Table (ALI).Ver (1 .. ALIs.Table (ALI).Ver_Len) /=
1600 Verbose_Library_Version
1602 Verbose_Msg (Full_Lib_File, "compiled with old GNAT version");
1607 -- Don't take Ali file into account if it was generated with
1610 if ALIs.Table (ALI).Compile_Errors then
1611 Verbose_Msg (Full_Lib_File, "had errors, must be recompiled");
1616 -- Don't take Ali file into account if it was generated without
1619 if Operating_Mode /= Check_Semantics
1620 and then ALIs.Table (ALI).No_Object
1622 Verbose_Msg (Full_Lib_File, "has no corresponding object");
1627 -- When compiling with -gnatc, don't take ALI file into account if
1628 -- it has not been generated for the current source, for example if
1629 -- it has been generated for the spec, but we are compiling the body.
1631 if Operating_Mode = Check_Semantics then
1633 File_Name : constant String := Get_Name_String (Source_File);
1634 OK : Boolean := False;
1637 for U in ALIs.Table (ALI).First_Unit ..
1638 ALIs.Table (ALI).Last_Unit
1640 OK := Get_Name_String (Units.Table (U).Sfile) = File_Name;
1646 (Full_Lib_File, "not generated for the same source");
1653 -- Check for matching compiler switches if needed
1655 if Check_Switches then
1657 -- First, collect all the switches
1659 Collect_Arguments (Source_File, Is_Main_Source, The_Args);
1661 Prev_Switch := Dummy_Switch;
1663 Get_Name_String (ALIs.Table (ALI).Sfile);
1665 Switches_To_Check.Set_Last (0);
1667 for J in 1 .. Last_Argument loop
1669 -- Skip non switches -c, -I and -o switches
1671 if Arguments (J) (1) = '-'
1672 and then Arguments (J) (2) /= 'c'
1673 and then Arguments (J) (2) /= 'o'
1674 and then Arguments (J) (2) /= 'I'
1676 Normalize_Compiler_Switches
1678 Normalized_Switches,
1681 for K in 1 .. Last_Norm_Switch loop
1682 Switches_To_Check.Increment_Last;
1683 Switches_To_Check.Table (Switches_To_Check.Last) :=
1684 Normalized_Switches (K);
1689 for J in 1 .. Switches_To_Check.Last loop
1691 -- Comparing switches is delicate because gcc reorders a number
1692 -- of switches, according to lang-specs.h, but gnatmake doesn't
1693 -- have sufficient knowledge to perform the same reordering.
1694 -- Instead, we ignore orders between different "first letter"
1695 -- switches, but keep orders between same switches, e.g -O -O2
1696 -- is different than -O2 -O, but -g -O is equivalent to -O -g.
1698 if Switches_To_Check.Table (J) (2) /= Prev_Switch (2) or else
1699 (Prev_Switch'Length >= 6 and then
1700 Prev_Switch (2 .. 5) = "gnat" and then
1701 Switches_To_Check.Table (J)'Length >= 6 and then
1702 Switches_To_Check.Table (J) (2 .. 5) = "gnat" and then
1703 Prev_Switch (6) /= Switches_To_Check.Table (J) (6))
1705 Prev_Switch := Switches_To_Check.Table (J);
1707 Units.Table (ALIs.Table (ALI).First_Unit).First_Arg;
1710 Switch_Found := False;
1713 Units.Table (ALIs.Table (ALI).First_Unit).Last_Arg
1716 Switches_To_Check.Table (J).all = Args.Table (K).all
1719 Switch_Found := True;
1724 if not Switch_Found then
1725 if Verbose_Mode then
1726 Verbose_Msg (ALIs.Table (ALI).Sfile,
1727 "switch mismatch """ &
1728 Switches_To_Check.Table (J).all & '"');
1736 if Switches_To_Check.Last /=
1737 Integer (Units.Table (ALIs.Table (ALI).First_Unit).Last_Arg -
1738 Units.Table (ALIs.Table (ALI).First_Unit).First_Arg + 1)
1740 if Verbose_Mode then
1741 Verbose_Msg (ALIs.Table (ALI).Sfile,
1742 "different number of switches");
1744 for K in Units.Table (ALIs.Table (ALI).First_Unit).First_Arg
1745 .. Units.Table (ALIs.Table (ALI).First_Unit).Last_Arg
1747 Write_Str (Args.Table (K).all);
1753 for J in 1 .. Switches_To_Check.Last loop
1754 Write_Str (Switches_To_Check.Table (J).all);
1766 -- Get the source files and their message digests. Note that some
1767 -- sources may be missing if ALI is out-of-date.
1769 Set_Source_Table (ALI);
1771 Modified_Source := Time_Stamp_Mismatch (ALI, Read_Only);
1773 -- To avoid using too much memory when switch -m is used, free the
1774 -- memory allocated for the source file when computing the checksum.
1776 if Minimal_Recompilation then
1777 Sinput.P.Clear_Source_File_Table;
1780 if Modified_Source /= No_File then
1783 if Verbose_Mode then
1784 Source_Name := Full_Source_Name (Modified_Source);
1786 if Source_Name /= No_File then
1787 Verbose_Msg (Source_Name, "time stamp mismatch");
1789 Verbose_Msg (Modified_Source, "missing");
1794 New_Spec := First_New_Spec (ALI);
1796 if New_Spec /= No_File then
1799 if Verbose_Mode then
1800 Source_Name := Full_Source_Name (New_Spec);
1802 if Source_Name /= No_File then
1803 Verbose_Msg (Source_Name, "new spec");
1805 Verbose_Msg (New_Spec, "old spec missing");
1809 elsif not Read_Only and then Main_Project /= No_Project then
1810 if not Check_Source_Info_In_ALI (ALI, Project_Tree) then
1815 -- Check that the ALI file is in the correct object directory.
1816 -- If it is in the object directory of a project that is
1817 -- extended and it depends on a source that is in one of its
1818 -- extending projects, then the ALI file is not in the correct
1819 -- object directory.
1821 -- First, find the project of this ALI file. As there may be
1822 -- several projects with the same object directory, we first
1823 -- need to find the project of the source.
1825 ALI_Project := No_Project;
1828 Udata : Prj.Unit_Index;
1831 Udata := Units_Htable.Get_First (Project_Tree.Units_HT);
1832 while Udata /= No_Unit_Index loop
1833 if Udata.File_Names (Impl) /= null
1834 and then Udata.File_Names (Impl).File = Source_File
1836 ALI_Project := Udata.File_Names (Impl).Project;
1839 elsif Udata.File_Names (Spec) /= null
1840 and then Udata.File_Names (Spec).File = Source_File
1842 ALI_Project := Udata.File_Names (Spec).Project;
1846 Udata := Units_Htable.Get_Next (Project_Tree.Units_HT);
1850 if ALI_Project = No_Project then
1855 Obj_Dir : Path_Name_Type;
1856 Res_Obj_Dir : constant String :=
1859 (Get_Name_String (Full_Lib_File)),
1861 Opt.Follow_Links_For_Dirs,
1862 Case_Sensitive => False);
1866 Add_Str_To_Name_Buffer (Res_Obj_Dir);
1868 if not Is_Directory_Separator (Name_Buffer (Name_Len)) then
1869 Add_Char_To_Name_Buffer (Directory_Separator);
1872 Obj_Dir := Name_Find;
1874 while ALI_Project /= No_Project
1875 and then Obj_Dir /= ALI_Project.Object_Directory.Name
1877 ALI_Project := ALI_Project.Extended_By;
1881 if ALI_Project = No_Project then
1884 Verbose_Msg (Lib_File, " wrong object directory");
1888 -- If the ALI project is not extended, then it must be in
1889 -- the correct object directory.
1891 if ALI_Project.Extended_By = No_Project then
1895 -- Count the extending projects
1903 Proj := ALI_Project;
1905 Proj := Proj.Extended_By;
1906 exit when Proj = No_Project;
1907 Num_Ext := Num_Ext + 1;
1910 -- Make a list of the extending projects
1913 Projects : array (1 .. Num_Ext) of Project_Id;
1915 OK : Boolean := True;
1919 Proj := ALI_Project;
1920 for J in Projects'Range loop
1921 Proj := Proj.Extended_By;
1922 Projects (J) := Proj;
1925 -- Now check if any of the dependant sources are in
1926 -- any of these extending projects.
1929 for D in ALIs.Table (ALI).First_Sdep ..
1930 ALIs.Table (ALI).Last_Sdep
1932 Dep := Sdep.Table (D);
1933 UID := Units_Htable.Get_First (Project_Tree.Units_HT);
1937 while UID /= null loop
1938 if UID.File_Names (Impl) /= null
1939 and then UID.File_Names (Impl).File = Dep.Sfile
1941 Proj := UID.File_Names (Impl).Project;
1943 elsif UID.File_Names (Spec) /= null
1944 and then UID.File_Names (Spec).File = Dep.Sfile
1946 Proj := UID.File_Names (Spec).Project;
1949 -- If a source is in a project, check if it is one
1952 if Proj /= No_Project then
1953 for J in Projects'Range loop
1954 if Proj = Projects (J) then
1964 Units_Htable.Get_Next (Project_Tree.Units_HT);
1968 -- If one of the dependent sources is in one project of
1969 -- the list, then we must recompile.
1973 Verbose_Msg (Lib_File, " wrong object directory");
1982 ------------------------
1983 -- Check_For_S_Switch --
1984 ------------------------
1986 procedure Check_For_S_Switch is
1988 -- By default, we generate an object file
1990 Output_Is_Object := True;
1992 for Arg in 1 .. Last_Argument loop
1993 if Arguments (Arg).all = "-S" then
1994 Output_Is_Object := False;
1996 elsif Arguments (Arg).all = "-c" then
1997 Output_Is_Object := True;
2000 end Check_For_S_Switch;
2002 --------------------------
2003 -- Check_Linker_Options --
2004 --------------------------
2006 procedure Check_Linker_Options
2007 (E_Stamp : Time_Stamp_Type;
2008 O_File : out File_Name_Type;
2009 O_Stamp : out Time_Stamp_Type)
2011 procedure Check_File (File : File_Name_Type);
2012 -- Update O_File and O_Stamp if the given file is younger than E_Stamp
2013 -- and O_Stamp, or if O_File is No_File and File does not exist.
2015 function Get_Library_File (Name : String) return File_Name_Type;
2016 -- Return the full file name including path of a library based
2017 -- on the name specified with the -l linker option, using the
2018 -- Ada object path. Return No_File if no such file can be found.
2020 type Char_Array is array (Natural) of Character;
2021 type Char_Array_Access is access constant Char_Array;
2023 Template : Char_Array_Access;
2024 pragma Import (C, Template, "__gnat_library_template");
2030 procedure Check_File (File : File_Name_Type) is
2031 Stamp : Time_Stamp_Type;
2032 Name : File_Name_Type := File;
2035 Get_Name_String (Name);
2037 -- Remove any trailing NUL characters
2039 while Name_Len >= Name_Buffer'First
2040 and then Name_Buffer (Name_Len) = NUL
2042 Name_Len := Name_Len - 1;
2045 if Name_Len = 0 then
2048 elsif Name_Buffer (1) = '-' then
2050 -- Do not check if File is a switch other than "-l"
2052 if Name_Buffer (2) /= 'l' then
2056 -- The argument is a library switch, get actual name. It
2057 -- is necessary to make a copy of the relevant part of
2058 -- Name_Buffer as Get_Library_Name uses Name_Buffer as well.
2061 Base_Name : constant String := Name_Buffer (3 .. Name_Len);
2064 Name := Get_Library_File (Base_Name);
2067 if Name = No_File then
2072 Stamp := File_Stamp (Name);
2074 -- Find the youngest object file that is younger than the
2075 -- executable. If no such file exist, record the first object
2076 -- file that is not found.
2078 if (O_Stamp < Stamp and then E_Stamp < Stamp)
2079 or else (O_File = No_File and then Stamp (Stamp'First) = ' ')
2084 -- Strip the trailing NUL if present
2086 Get_Name_String (O_File);
2088 if Name_Buffer (Name_Len) = NUL then
2089 Name_Len := Name_Len - 1;
2090 O_File := Name_Find;
2095 ----------------------
2096 -- Get_Library_Name --
2097 ----------------------
2099 -- See comments in a-adaint.c about template syntax
2101 function Get_Library_File (Name : String) return File_Name_Type is
2102 File : File_Name_Type := No_File;
2107 for Ptr in Template'Range loop
2108 case Template (Ptr) is
2110 Add_Str_To_Name_Buffer (Name);
2113 File := Full_Lib_File_Name (Name_Find);
2114 exit when File /= No_File;
2121 Add_Char_To_Name_Buffer (Template (Ptr));
2125 -- The for loop exited because the end of the template
2126 -- was reached. File contains the last possible file name
2129 if File = No_File and then Name_Len > 0 then
2130 File := Full_Lib_File_Name (Name_Find);
2134 end Get_Library_File;
2136 -- Start of processing for Check_Linker_Options
2140 O_Stamp := (others => ' ');
2142 -- Process linker options from the ALI files
2144 for Opt in 1 .. Linker_Options.Last loop
2145 Check_File (File_Name_Type (Linker_Options.Table (Opt).Name));
2148 -- Process options given on the command line
2150 for Opt in Linker_Switches.First .. Linker_Switches.Last loop
2152 -- Check if the previous Opt has one of the two switches
2153 -- that take an extra parameter. (See GCC manual.)
2155 if Opt = Linker_Switches.First
2156 or else (Linker_Switches.Table (Opt - 1).all /= "-u"
2158 Linker_Switches.Table (Opt - 1).all /= "-Xlinker"
2160 Linker_Switches.Table (Opt - 1).all /= "-L")
2163 Add_Str_To_Name_Buffer (Linker_Switches.Table (Opt).all);
2164 Check_File (Name_Find);
2167 end Check_Linker_Options;
2173 procedure Check_Steps is
2175 -- If either -c, -b or -l has been specified, we will not necessarily
2176 -- execute all steps.
2179 Do_Compile_Step := Do_Compile_Step and Compile_Only;
2180 Do_Bind_Step := Do_Bind_Step and Bind_Only;
2181 Do_Link_Step := Do_Link_Step and Link_Only;
2183 -- If -c has been specified, but not -b, ignore any potential -l
2185 if Do_Compile_Step and then not Do_Bind_Step then
2186 Do_Link_Step := False;
2191 -----------------------
2192 -- Collect_Arguments --
2193 -----------------------
2195 procedure Collect_Arguments
2196 (Source_File : File_Name_Type;
2197 Is_Main_Source : Boolean;
2198 Args : Argument_List)
2201 Arguments_Project := No_Project;
2203 Add_Arguments (Args);
2205 if Main_Project /= No_Project then
2207 Source_File_Name : constant String :=
2208 Get_Name_String (Source_File);
2209 Compiler_Package : Prj.Package_Id;
2210 Switches : Prj.Variable_Value;
2215 (Source_File_Name => Source_File_Name,
2216 Project => Arguments_Project,
2217 Path => Arguments_Path_Name,
2218 In_Tree => Project_Tree);
2220 -- If the source is not a source of a project file, add the
2221 -- recorded arguments. Check will be done later if the source
2222 -- need to be compiled that the switch -x has been used.
2224 if Arguments_Project = No_Project then
2225 Add_Arguments (The_Saved_Gcc_Switches.all);
2227 elsif not Arguments_Project.Externally_Built
2228 or else Must_Compile
2230 -- We get the project directory for the relative path
2231 -- switches and arguments.
2233 Arguments_Project :=
2234 Ultimate_Extending_Project_Of (Arguments_Project);
2236 -- If building a dynamic or relocatable library, compile with
2237 -- PIC option, if it exists.
2239 if Arguments_Project.Library
2240 and then Arguments_Project.Library_Kind /= Static
2243 PIC : constant String := MLib.Tgt.PIC_Option;
2246 Add_Arguments ((1 => new String'(PIC)));
2251 -- We now look for package Compiler and get the switches from
2256 (Name => Name_Compiler,
2257 In_Packages => Arguments_Project.Decl.Packages,
2258 Shared => Project_Tree.Shared);
2260 if Compiler_Package /= No_Package then
2262 -- If package Gnatmake.Compiler exists, we get the specific
2263 -- switches for the current source, or the global switches,
2268 (Source_File => Source_File,
2269 Project => Arguments_Project,
2270 In_Package => Compiler_Package,
2271 Allow_ALI => False);
2275 case Switches.Kind is
2277 -- We have a list of switches. We add these switches,
2278 -- plus the saved gcc switches.
2283 Current : String_List_Id := Switches.Values;
2284 Element : String_Element;
2285 Number : Natural := 0;
2288 while Current /= Nil_String loop
2289 Element := Project_Tree.Shared.String_Elements.
2291 Number := Number + 1;
2292 Current := Element.Next;
2296 New_Args : Argument_List (1 .. Number);
2297 Last_New : Natural := 0;
2298 Dir_Path : constant String := Get_Name_String
2299 (Arguments_Project.Directory.Display_Name);
2302 Current := Switches.Values;
2304 for Index in New_Args'Range loop
2305 Element := Project_Tree.Shared.String_Elements.
2307 Get_Name_String (Element.Value);
2309 if Name_Len > 0 then
2310 Last_New := Last_New + 1;
2311 New_Args (Last_New) :=
2312 new String'(Name_Buffer (1 .. Name_Len));
2313 Test_If_Relative_Path
2314 (New_Args (Last_New),
2315 Do_Fail => Make_Failed'Access,
2317 Including_Non_Switch => False);
2320 Current := Element.Next;
2324 (Configuration_Pragmas_Switch
2325 (Arguments_Project) &
2326 New_Args (1 .. Last_New) &
2327 The_Saved_Gcc_Switches.all);
2331 -- We have a single switch. We add this switch,
2332 -- plus the saved gcc switches.
2335 Get_Name_String (Switches.Value);
2338 New_Args : Argument_List :=
2340 (Name_Buffer (1 .. Name_Len)));
2341 Dir_Path : constant String :=
2344 Directory.Display_Name);
2347 Test_If_Relative_Path
2349 Do_Fail => Make_Failed'Access,
2351 Including_Non_Switch => False);
2353 (Configuration_Pragmas_Switch (Arguments_Project) &
2354 New_Args & The_Saved_Gcc_Switches.all);
2357 -- We have no switches from Gnatmake.Compiler.
2358 -- We add the saved gcc switches.
2362 (Configuration_Pragmas_Switch (Arguments_Project) &
2363 The_Saved_Gcc_Switches.all);
2369 -- For VMS, when compiling the main source, add switch
2370 -- -mdebug-main=_ada_ so that the executable can be debugged
2371 -- by the standard VMS debugger.
2373 if not No_Main_Subprogram
2374 and then Targparm.OpenVMS_On_Target
2375 and then Is_Main_Source
2377 -- First, check if compilation will be invoked with -g
2379 for J in 1 .. Last_Argument loop
2380 if Arguments (J)'Length >= 2
2381 and then Arguments (J) (1 .. 2) = "-g"
2382 and then (Arguments (J)'Length < 5
2383 or else Arguments (J) (1 .. 5) /= "-gnat")
2386 ((1 => new String'("-mdebug-main=_ada_")));
2392 -- Set Output_Is_Object, depending if there is a -S switch.
2393 -- If the bind step is not performed, and there is a -S switch,
2394 -- then we will not check for a valid object file.
2397 end Collect_Arguments;
2399 ---------------------
2400 -- Compile_Sources --
2401 ---------------------
2403 procedure Compile_Sources
2404 (Main_Source : File_Name_Type;
2405 Args : Argument_List;
2406 First_Compiled_File : out File_Name_Type;
2407 Most_Recent_Obj_File : out File_Name_Type;
2408 Most_Recent_Obj_Stamp : out Time_Stamp_Type;
2409 Main_Unit : out Boolean;
2410 Compilation_Failures : out Natural;
2411 Main_Index : Int := 0;
2412 Check_Readonly_Files : Boolean := False;
2413 Do_Not_Execute : Boolean := False;
2414 Force_Compilations : Boolean := False;
2415 Keep_Going : Boolean := False;
2416 In_Place_Mode : Boolean := False;
2417 Initialize_ALI_Data : Boolean := True;
2418 Max_Process : Positive := 1)
2420 Mfile : Natural := No_Mapping_File;
2421 Mapping_File_Arg : String_Access;
2422 -- Info on the mapping file
2424 Need_To_Check_Standard_Library : Boolean :=
2425 (Check_Readonly_Files or Must_Compile)
2426 and not Unique_Compile;
2428 procedure Add_Process
2430 Sfile : File_Name_Type;
2431 Afile : File_Name_Type;
2432 Uname : Unit_Name_Type;
2433 Full_Lib_File : File_Name_Type;
2434 Lib_File_Attr : File_Attributes;
2435 Mfile : Natural := No_Mapping_File);
2436 -- Adds process Pid to the current list of outstanding compilation
2437 -- processes and record the full name of the source file Sfile that
2438 -- we are compiling, the name of its library file Afile and the
2439 -- name of its unit Uname. If Mfile is not equal to No_Mapping_File,
2440 -- it is the index of the mapping file used during compilation in the
2441 -- array The_Mapping_File_Names.
2443 procedure Await_Compile
2444 (Data : out Compilation_Data;
2446 -- Awaits that an outstanding compilation process terminates. When it
2447 -- does set Data to the information registered for the corresponding
2448 -- call to Add_Process. Note that this time stamp can be used to check
2449 -- whether the compilation did generate an object file. OK is set to
2450 -- True if the compilation succeeded. Data could be No_Compilation_Data
2451 -- if there was no compilation to wait for.
2453 function Bad_Compilation_Count return Natural;
2454 -- Returns the number of compilation failures
2456 procedure Check_Standard_Library;
2457 -- Check if s-stalib.adb needs to be compiled
2459 procedure Collect_Arguments_And_Compile
2460 (Full_Source_File : File_Name_Type;
2461 Lib_File : File_Name_Type;
2463 Pid : out Process_Id;
2464 Process_Created : out Boolean);
2465 -- Collect arguments from project file (if any) and compile. If no
2466 -- compilation was attempted, Processed_Created is set to False, and the
2467 -- value of Pid is unknown.
2470 (Project : Project_Id;
2474 Args : Argument_List) return Process_Id;
2475 -- Compiles S using Args. If S is a GNAT predefined source "-gnatpg" is
2476 -- added to Args. Non blocking call. L corresponds to the expected
2477 -- library file name. Process_Id of the process spawned to execute the
2480 type ALI_Project is record
2482 Project : Project_Id;
2485 package Good_ALI is new Table.Table (
2486 Table_Component_Type => ALI_Project,
2487 Table_Index_Type => Natural,
2488 Table_Low_Bound => 1,
2489 Table_Initial => 50,
2490 Table_Increment => 100,
2491 Table_Name => "Make.Good_ALI");
2492 -- Contains the set of valid ALI files that have not yet been scanned
2494 function Good_ALI_Present return Boolean;
2495 -- Returns True if any ALI file was recorded in the previous set
2497 procedure Get_Mapping_File (Project : Project_Id);
2498 -- Get a mapping file name. If there is one to be reused, reuse it.
2499 -- Otherwise, create a new mapping file.
2501 function Get_Next_Good_ALI return ALI_Project;
2502 -- Returns the next good ALI_Id record
2504 procedure Record_Failure
2505 (File : File_Name_Type;
2506 Unit : Unit_Name_Type;
2507 Found : Boolean := True);
2508 -- Records in the previous table that the compilation for File failed.
2509 -- If Found is False then the compilation of File failed because we
2510 -- could not find it. Records also Unit when possible.
2512 procedure Record_Good_ALI (A : ALI_Id; Project : Project_Id);
2513 -- Records in the previous set the Id of an ALI file
2515 function Must_Exit_Because_Of_Error return Boolean;
2516 -- Return True if there were errors and the user decided to exit in such
2517 -- a case. This waits for any outstanding compilation.
2519 function Start_Compile_If_Possible (Args : Argument_List) return Boolean;
2520 -- Check if there is more work that we can do (i.e. the Queue is non
2521 -- empty). If there is, do it only if we have not yet used up all the
2522 -- available processes.
2523 -- Returns True if we should exit the main loop
2525 procedure Wait_For_Available_Slot;
2526 -- Check if we should wait for a compilation to finish. This is the case
2527 -- if all the available processes are busy compiling sources or there is
2528 -- nothing else to do (that is the Q is empty and there are no good ALIs
2531 procedure Fill_Queue_From_ALI_Files;
2532 -- Check if we recorded good ALI files. If yes process them now in the
2533 -- order in which they have been recorded. There are two occasions in
2534 -- which we record good ali files. The first is in phase 1 when, after
2535 -- scanning an existing ALI file we realize it is up-to-date, the second
2536 -- instance is after a successful compilation.
2542 procedure Add_Process
2544 Sfile : File_Name_Type;
2545 Afile : File_Name_Type;
2546 Uname : Unit_Name_Type;
2547 Full_Lib_File : File_Name_Type;
2548 Lib_File_Attr : File_Attributes;
2549 Mfile : Natural := No_Mapping_File)
2551 OC1 : constant Positive := Outstanding_Compiles + 1;
2554 pragma Assert (OC1 <= Max_Process);
2555 pragma Assert (Pid /= Invalid_Pid);
2557 Running_Compile (OC1) :=
2559 Full_Source_File => Sfile,
2561 Full_Lib_File => Full_Lib_File,
2562 Lib_File_Attr => Lib_File_Attr,
2563 Source_Unit => Uname,
2564 Mapping_File => Mfile,
2565 Project => Arguments_Project);
2567 Outstanding_Compiles := OC1;
2569 if Arguments_Project /= No_Project then
2570 Queue.Set_Obj_Dir_Busy (Arguments_Project.Object_Directory.Name);
2574 --------------------
2578 procedure Await_Compile
2579 (Data : out Compilation_Data;
2583 Project : Project_Id;
2584 Comp_Data : Project_Compilation_Access;
2587 pragma Assert (Outstanding_Compiles > 0);
2589 Data := No_Compilation_Data;
2592 -- The loop here is a work-around for a problem on VMS; in some
2593 -- circumstances (shared library and several executables, for
2594 -- example), there are child processes other than compilation
2595 -- processes that are received. Until this problem is resolved,
2596 -- we will ignore such processes.
2599 Wait_Process (Pid, OK);
2601 if Pid = Invalid_Pid then
2605 for J in Running_Compile'First .. Outstanding_Compiles loop
2606 if Pid = Running_Compile (J).Pid then
2607 Data := Running_Compile (J);
2608 Project := Running_Compile (J).Project;
2610 if Project /= No_Project then
2611 Queue.Set_Obj_Dir_Free (Project.Object_Directory.Name);
2614 -- If a mapping file was used by this compilation, get its
2615 -- file name for reuse by a subsequent compilation.
2617 if Running_Compile (J).Mapping_File /= No_Mapping_File then
2619 Project_Compilation_Htable.Get
2620 (Project_Compilation, Project);
2621 Comp_Data.Last_Free_Indexes :=
2622 Comp_Data.Last_Free_Indexes + 1;
2623 Comp_Data.Free_Mapping_File_Indexes
2624 (Comp_Data.Last_Free_Indexes) :=
2625 Running_Compile (J).Mapping_File;
2628 -- To actually remove this Pid and related info from
2629 -- Running_Compile replace its entry with the last valid
2630 -- entry in Running_Compile.
2632 if J = Outstanding_Compiles then
2635 Running_Compile (J) :=
2636 Running_Compile (Outstanding_Compiles);
2639 Outstanding_Compiles := Outstanding_Compiles - 1;
2644 -- This child process was not one of our compilation processes;
2645 -- just ignore it for now.
2647 -- Why is this commented out code sitting here???
2649 -- raise Program_Error;
2653 ---------------------------
2654 -- Bad_Compilation_Count --
2655 ---------------------------
2657 function Bad_Compilation_Count return Natural is
2659 return Bad_Compilation.Last - Bad_Compilation.First + 1;
2660 end Bad_Compilation_Count;
2662 ----------------------------
2663 -- Check_Standard_Library --
2664 ----------------------------
2666 procedure Check_Standard_Library is
2668 Need_To_Check_Standard_Library := False;
2670 if not Targparm.Suppress_Standard_Library_On_Target then
2672 Sfile : File_Name_Type;
2673 Add_It : Boolean := True;
2677 Add_Str_To_Name_Buffer (Standard_Library_Package_Body_Name);
2678 Sfile := Name_Enter;
2680 -- If we have a special runtime, we add the standard
2681 -- library only if we can find it.
2684 Add_It := Full_Source_Name (Sfile) /= No_File;
2689 ((Format => Format_Gnatmake,
2691 Unit => No_Unit_Name,
2692 Project => No_Project,
2695 if Is_In_Obsoleted (Sfile) then
2696 Executable_Obsolete := True;
2702 end Check_Standard_Library;
2704 -----------------------------------
2705 -- Collect_Arguments_And_Compile --
2706 -----------------------------------
2708 procedure Collect_Arguments_And_Compile
2709 (Full_Source_File : File_Name_Type;
2710 Lib_File : File_Name_Type;
2712 Pid : out Process_Id;
2713 Process_Created : out Boolean) is
2715 Process_Created := False;
2717 -- If we use mapping file (-P or -C switches), then get one
2719 if Create_Mapping_File then
2720 Get_Mapping_File (Arguments_Project);
2723 -- If the source is part of a project file, we set the ADA_*_PATHs,
2724 -- check for an eventual library project, and use the full path.
2726 if Arguments_Project /= No_Project then
2727 if not Arguments_Project.Externally_Built
2728 or else Must_Compile
2730 Prj.Env.Set_Ada_Paths
2733 Including_Libraries => True,
2734 Include_Path => Use_Include_Path_File);
2736 if not Unique_Compile
2737 and then MLib.Tgt.Support_For_Libraries /= Prj.None
2740 Prj : constant Project_Id :=
2741 Ultimate_Extending_Project_Of (Arguments_Project);
2745 and then (not Prj.Externally_Built or else Must_Compile)
2746 and then not Prj.Need_To_Build_Lib
2748 -- Add to the Q all sources of the project that have
2751 Insert_Project_Sources
2752 (The_Project => Prj,
2753 All_Projects => False,
2756 -- Now mark the project as processed
2758 Prj.Need_To_Build_Lib := True;
2765 (Project => Arguments_Project,
2766 S => File_Name_Type (Arguments_Path_Name),
2768 Source_Index => Source_Index,
2769 Args => Arguments (1 .. Last_Argument));
2770 Process_Created := True;
2774 -- If this is a source outside of any project file, make sure it
2775 -- will be compiled in object directory of the main project file.
2779 (Project => Main_Project,
2780 S => Full_Source_File,
2782 Source_Index => Source_Index,
2783 Args => Arguments (1 .. Last_Argument));
2784 Process_Created := True;
2786 end Collect_Arguments_And_Compile;
2793 (Project : Project_Id;
2797 Args : Argument_List) return Process_Id
2799 Comp_Args : Argument_List (Args'First .. Args'Last + 10);
2800 Comp_Next : Integer := Args'First;
2801 Comp_Last : Integer;
2802 Arg_Index : Integer;
2804 function Ada_File_Name (Name : File_Name_Type) return Boolean;
2805 -- Returns True if Name is the name of an ada source file
2806 -- (i.e. suffix is .ads or .adb)
2812 function Ada_File_Name (Name : File_Name_Type) return Boolean is
2814 Get_Name_String (Name);
2817 and then Name_Buffer (Name_Len - 3 .. Name_Len - 1) = ".ad"
2818 and then (Name_Buffer (Name_Len) = 'b'
2820 Name_Buffer (Name_Len) = 's');
2823 -- Start of processing for Compile
2826 Enter_Into_Obsoleted (S);
2828 -- By default, Syntax_Only is False
2830 Syntax_Only := False;
2832 for J in Args'Range loop
2833 if Args (J).all = "-gnats" then
2835 -- If we compile with -gnats, the bind step and the link step
2836 -- are inhibited. Also, we set Syntax_Only to True, so that
2837 -- we don't fail when we don't find the ALI file, after
2840 Do_Bind_Step := False;
2841 Do_Link_Step := False;
2842 Syntax_Only := True;
2844 elsif Args (J).all = "-gnatc" then
2846 -- If we compile with -gnatc, the bind step and the link step
2847 -- are inhibited. We set Syntax_Only to False for the case when
2848 -- -gnats was previously specified.
2850 Do_Bind_Step := False;
2851 Do_Link_Step := False;
2852 Syntax_Only := False;
2854 elsif Args (J).all = "-gnatC"
2855 or else Args (J).all = "-gnatcC"
2857 -- If we compile with -gnatC, enable CodePeer globalize step
2859 Do_Codepeer_Globalize_Step := True;
2863 Comp_Args (Comp_Next) := new String'("-gnatea");
2864 Comp_Next := Comp_Next + 1;
2866 Comp_Args (Comp_Next) := Comp_Flag;
2867 Comp_Next := Comp_Next + 1;
2869 -- Optimize the simple case where the gcc command line looks like
2870 -- gcc -c -I. ... -I- file.adb
2872 -- gcc -c ... file.adb
2874 if Args (Args'First).all = "-I" & Normalized_CWD
2875 and then Args (Args'Last).all = "-I-"
2876 and then S = Strip_Directory (S)
2878 Comp_Last := Comp_Next + Args'Length - 3;
2879 Arg_Index := Args'First + 1;
2882 Comp_Last := Comp_Next + Args'Length - 1;
2883 Arg_Index := Args'First;
2886 -- Make a deep copy of the arguments, because Normalize_Arguments
2887 -- may deallocate some arguments. Also strip target specific -mxxx
2888 -- switches in CodePeer mode.
2892 Last : constant Natural := Comp_Last;
2896 for J in Comp_Next .. Last loop
2898 Str : String renames Args (Arg_Index).all;
2900 if Do_Codepeer_Globalize_Step
2901 and then Str'Length > 2
2902 and then Str (Str'First .. Str'First + 1) = "-m"
2904 Comp_Last := Comp_Last - 1;
2906 Comp_Args (Index) := new String'(Str);
2911 Arg_Index := Arg_Index + 1;
2915 -- Set -gnatpg for predefined files (for this purpose the renamings
2916 -- such as Text_IO do not count as predefined). Note that we strip
2917 -- the directory name from the source file name because the call to
2918 -- Fname.Is_Predefined_File_Name cannot deal with directory prefixes.
2921 Fname : constant File_Name_Type := Strip_Directory (S);
2924 if Is_Predefined_File_Name (Fname, False) then
2925 if Check_Readonly_Files or else Must_Compile then
2926 Comp_Args (Comp_Args'First + 2 .. Comp_Last + 1) :=
2927 Comp_Args (Comp_Args'First + 1 .. Comp_Last);
2928 Comp_Last := Comp_Last + 1;
2929 Comp_Args (Comp_Args'First + 1) := GNAT_Flag;
2933 ("not allowed to compile """ &
2934 Get_Name_String (Fname) &
2935 """; use -a switch, or compile file with " &
2936 """-gnatg"" switch");
2941 -- Now check if the file name has one of the suffixes familiar to
2942 -- the gcc driver. If this is not the case then add the ada flag
2945 if not Ada_File_Name (S) and then not Targparm.AAMP_On_Target then
2946 Comp_Last := Comp_Last + 1;
2947 Comp_Args (Comp_Last) := Ada_Flag_1;
2948 Comp_Last := Comp_Last + 1;
2949 Comp_Args (Comp_Last) := Ada_Flag_2;
2952 if Source_Index /= 0 then
2954 Num : constant String := Source_Index'Img;
2956 Comp_Last := Comp_Last + 1;
2957 Comp_Args (Comp_Last) :=
2958 new String'("-gnateI" & Num (Num'First + 1 .. Num'Last));
2962 if Source_Index /= 0
2963 or else L /= Strip_Directory (L)
2964 or else Object_Directory_Path /= null
2966 -- Build -o argument
2968 Get_Name_String (L);
2970 for J in reverse 1 .. Name_Len loop
2971 if Name_Buffer (J) = '.' then
2972 Name_Len := J + Object_Suffix'Length - 1;
2973 Name_Buffer (J .. Name_Len) := Object_Suffix;
2978 Comp_Last := Comp_Last + 1;
2979 Comp_Args (Comp_Last) := Output_Flag;
2980 Comp_Last := Comp_Last + 1;
2982 -- If an object directory was specified, prepend the object file
2983 -- name with this object directory.
2985 if Object_Directory_Path /= null then
2986 Comp_Args (Comp_Last) :=
2987 new String'(Object_Directory_Path.all &
2988 Name_Buffer (1 .. Name_Len));
2991 Comp_Args (Comp_Last) :=
2992 new String'(Name_Buffer (1 .. Name_Len));
2996 if Create_Mapping_File and then Mapping_File_Arg /= null then
2997 Comp_Last := Comp_Last + 1;
2998 Comp_Args (Comp_Last) := new String'(Mapping_File_Arg.all);
3001 Get_Name_String (S);
3003 Comp_Last := Comp_Last + 1;
3004 Comp_Args (Comp_Last) := new String'(Name_Buffer (1 .. Name_Len));
3006 -- Change to object directory of the project file, if necessary
3008 if Project /= No_Project then
3009 Change_To_Object_Directory (Project);
3012 GNAT.OS_Lib.Normalize_Arguments (Comp_Args (Args'First .. Comp_Last));
3014 Comp_Last := Comp_Last + 1;
3015 Comp_Args (Comp_Last) := new String'("-gnatez");
3017 Display (Gcc.all, Comp_Args (Args'First .. Comp_Last));
3019 if Gcc_Path = null then
3020 Make_Failed ("error, unable to locate " & Gcc.all);
3024 GNAT.OS_Lib.Non_Blocking_Spawn
3025 (Gcc_Path.all, Comp_Args (Args'First .. Comp_Last));
3028 -------------------------------
3029 -- Fill_Queue_From_ALI_Files --
3030 -------------------------------
3032 procedure Fill_Queue_From_ALI_Files is
3033 ALI_P : ALI_Project;
3036 Sfile : File_Name_Type;
3037 Uname : Unit_Name_Type;
3038 Unit_Name : Name_Id;
3039 Uid : Prj.Unit_Index;
3042 while Good_ALI_Present loop
3043 ALI_P := Get_Next_Good_ALI;
3045 Source_Index := Unit_Index_Of (ALIs.Table (ALI_P.ALI).Afile);
3047 -- If we are processing the library file corresponding to the
3048 -- main source file check if this source can be a main unit.
3050 if ALIs.Table (ALI).Sfile = Main_Source
3051 and then Source_Index = Main_Index
3053 Main_Unit := ALIs.Table (ALI).Main_Program /= None;
3056 -- The following adds the standard library (s-stalib) to the list
3057 -- of files to be handled by gnatmake: this file and any files it
3058 -- depends on are always included in every bind, even if they are
3059 -- not in the explicit dependency list. Of course, it is not added
3060 -- if Suppress_Standard_Library is True.
3062 -- However, to avoid annoying output about s-stalib.ali being read
3063 -- only, when "-v" is used, we add the standard library only when
3066 if Need_To_Check_Standard_Library then
3067 Check_Standard_Library;
3070 -- Now insert in the Q the unmarked source files (i.e. those which
3071 -- have never been inserted in the Q and hence never considered).
3072 -- Only do that if Unique_Compile is False.
3074 if not Unique_Compile then
3076 ALIs.Table (ALI).First_Unit .. ALIs.Table (ALI).Last_Unit
3079 Units.Table (J).First_With .. Units.Table (J).Last_With
3081 Sfile := Withs.Table (K).Sfile;
3082 Uname := Withs.Table (K).Uname;
3084 -- If project files are used, find the proper source to
3085 -- compile in case Sfile is the spec but there is a body.
3087 if Main_Project /= No_Project then
3088 Get_Name_String (Uname);
3089 Name_Len := Name_Len - 2;
3090 Unit_Name := Name_Find;
3092 Units_Htable.Get (Project_Tree.Units_HT, Unit_Name);
3094 if Uid /= Prj.No_Unit_Index then
3095 if Uid.File_Names (Impl) /= null
3096 and then not Uid.File_Names (Impl).Locally_Removed
3098 Sfile := Uid.File_Names (Impl).File;
3099 Source_Index := Uid.File_Names (Impl).Index;
3101 elsif Uid.File_Names (Spec) /= null
3102 and then not Uid.File_Names (Spec).Locally_Removed
3104 Sfile := Uid.File_Names (Spec).File;
3105 Source_Index := Uid.File_Names (Spec).Index;
3110 Dependencies.Append ((ALIs.Table (ALI).Sfile, Sfile));
3112 if Is_In_Obsoleted (Sfile) then
3113 Executable_Obsolete := True;
3116 if Sfile = No_File then
3117 Debug_Msg ("Skipping generic:", Withs.Table (K).Uname);
3120 Source_Index := Unit_Index_Of (Withs.Table (K).Afile);
3122 if not (Check_Readonly_Files or Must_Compile)
3123 and then Is_Internal_File_Name (Sfile, False)
3125 Debug_Msg ("Skipping internal file:", Sfile);
3129 ((Format => Format_Gnatmake,
3131 Project => ALI_P.Project,
3132 Unit => Withs.Table (K).Uname,
3133 Index => Source_Index));
3140 end Fill_Queue_From_ALI_Files;
3142 ----------------------
3143 -- Get_Mapping_File --
3144 ----------------------
3146 procedure Get_Mapping_File (Project : Project_Id) is
3147 Data : Project_Compilation_Access;
3150 Data := Project_Compilation_Htable.Get (Project_Compilation, Project);
3152 -- If there is a mapping file ready to be reused, reuse it
3154 if Data.Last_Free_Indexes > 0 then
3155 Mfile := Data.Free_Mapping_File_Indexes (Data.Last_Free_Indexes);
3156 Data.Last_Free_Indexes := Data.Last_Free_Indexes - 1;
3158 -- Otherwise, create and initialize a new one
3162 (Project => Project, Data => Data.all, File_Index => Mfile);
3165 -- Put the name in the mapping file argument for the invocation
3168 Free (Mapping_File_Arg);
3170 new String'("-gnatem=" &
3171 Get_Name_String (Data.Mapping_File_Names (Mfile)));
3172 end Get_Mapping_File;
3174 -----------------------
3175 -- Get_Next_Good_ALI --
3176 -----------------------
3178 function Get_Next_Good_ALI return ALI_Project is
3182 pragma Assert (Good_ALI_Present);
3183 ALIP := Good_ALI.Table (Good_ALI.Last);
3184 Good_ALI.Decrement_Last;
3186 end Get_Next_Good_ALI;
3188 ----------------------
3189 -- Good_ALI_Present --
3190 ----------------------
3192 function Good_ALI_Present return Boolean is
3194 return Good_ALI.First <= Good_ALI.Last;
3195 end Good_ALI_Present;
3197 --------------------------------
3198 -- Must_Exit_Because_Of_Error --
3199 --------------------------------
3201 function Must_Exit_Because_Of_Error return Boolean is
3202 Data : Compilation_Data;
3206 if Bad_Compilation_Count > 0 and then not Keep_Going then
3207 while Outstanding_Compiles > 0 loop
3208 Await_Compile (Data, Success);
3211 Record_Failure (Data.Full_Source_File, Data.Source_Unit);
3219 end Must_Exit_Because_Of_Error;
3221 --------------------
3222 -- Record_Failure --
3223 --------------------
3225 procedure Record_Failure
3226 (File : File_Name_Type;
3227 Unit : Unit_Name_Type;
3228 Found : Boolean := True)
3231 Bad_Compilation.Increment_Last;
3232 Bad_Compilation.Table (Bad_Compilation.Last) := (File, Unit, Found);
3235 ---------------------
3236 -- Record_Good_ALI --
3237 ---------------------
3239 procedure Record_Good_ALI (A : ALI_Id; Project : Project_Id) is
3241 Good_ALI.Increment_Last;
3242 Good_ALI.Table (Good_ALI.Last) := (A, Project);
3243 end Record_Good_ALI;
3245 -------------------------------
3246 -- Start_Compile_If_Possible --
3247 -------------------------------
3249 function Start_Compile_If_Possible
3250 (Args : Argument_List) return Boolean
3252 In_Lib_Dir : Boolean;
3253 Need_To_Compile : Boolean;
3255 Process_Created : Boolean;
3257 Source : Queue.Source_Info;
3258 Full_Source_File : File_Name_Type;
3259 Source_File_Attr : aliased File_Attributes;
3260 -- The full name of the source file and its attributes (size, ...)
3262 Lib_File : File_Name_Type;
3263 Full_Lib_File : File_Name_Type;
3264 Lib_File_Attr : aliased File_Attributes;
3265 Read_Only : Boolean := False;
3267 -- The ALI file and its attributes (size, stamp, ...)
3269 Obj_File : File_Name_Type;
3270 Obj_Stamp : Time_Stamp_Type;
3276 if not Queue.Is_Virtually_Empty and then
3277 Outstanding_Compiles < Max_Process
3279 Queue.Extract (Found, Source);
3281 Osint.Full_Source_Name
3283 Full_File => Full_Source_File,
3284 Attr => Source_File_Attr'Access);
3286 Lib_File := Osint.Lib_File_Name (Source.File, Source.Index);
3288 -- ??? This call could be avoided when using projects, since we
3289 -- know where the ALI file is supposed to be. That would avoid
3290 -- searches in the object directories, including in the runtime
3291 -- dir. However, that would require getting access to the
3294 Osint.Full_Lib_File_Name
3296 Lib_File => Full_Lib_File,
3297 Attr => Lib_File_Attr);
3299 -- If source has already been compiled, executable is obsolete
3301 if Is_In_Obsoleted (Source.File) then
3302 Executable_Obsolete := True;
3305 In_Lib_Dir := Full_Lib_File /= No_File
3306 and then In_Ada_Lib_Dir (Full_Lib_File);
3308 -- Since the following requires a system call, we precompute it
3311 if not In_Lib_Dir then
3312 if Full_Lib_File /= No_File
3313 and then not (Check_Readonly_Files or else Must_Compile)
3315 Get_Name_String (Full_Lib_File);
3316 Name_Buffer (Name_Len + 1) := ASCII.NUL;
3317 Read_Only := not Is_Writable_File
3318 (Name_Buffer'Address, Lib_File_Attr'Access);
3324 -- If the library file is an Ada library skip it
3329 "is in an Ada library",
3331 Minimum_Verbosity => Opt.High);
3333 -- If the library file is a read-only library skip it, but only
3334 -- if, when using project files, this library file is in the
3335 -- right object directory (a read-only ALI file in the object
3336 -- directory of a project being extended must not be skipped).
3339 and then Is_In_Object_Directory (Source.File, Full_Lib_File)
3343 "is a read-only library",
3345 Minimum_Verbosity => Opt.High);
3347 -- The source file that we are checking cannot be located
3349 elsif Full_Source_File = No_File then
3350 Record_Failure (Source.File, Source.Unit, False);
3352 -- Source and library files can be located but are internal
3355 elsif not (Check_Readonly_Files or else Must_Compile)
3356 and then Full_Lib_File /= No_File
3357 and then Is_Internal_File_Name (Source.File, False)
3359 if Force_Compilations then
3361 ("not allowed to compile """ &
3362 Get_Name_String (Source.File) &
3363 """; use -a switch, or compile file with " &
3364 """-gnatg"" switch");
3369 "is an internal library",
3371 Minimum_Verbosity => Opt.High);
3373 -- The source file that we are checking can be located
3377 (Source.File, Source.File = Main_Source, Args);
3379 -- Do nothing if project of source is externally built
3381 if Arguments_Project = No_Project
3382 or else not Arguments_Project.Externally_Built
3383 or else Must_Compile
3385 -- Don't waste any time if we have to recompile anyway
3387 Obj_Stamp := Empty_Time_Stamp;
3388 Need_To_Compile := Force_Compilations;
3390 if not Force_Compilations then
3391 Check (Source_File => Source.File,
3392 Source_Index => Source.Index,
3393 Is_Main_Source => Source.File = Main_Source,
3395 Lib_File => Lib_File,
3396 Full_Lib_File => Full_Lib_File,
3397 Lib_File_Attr => Lib_File_Attr'Access,
3398 Read_Only => Read_Only,
3401 O_Stamp => Obj_Stamp);
3402 Need_To_Compile := (ALI = No_ALI_Id);
3405 if not Need_To_Compile then
3407 -- The ALI file is up-to-date; record its Id
3409 Record_Good_ALI (ALI, Arguments_Project);
3411 -- Record the time stamp of the most recent object
3412 -- file as long as no (re)compilations are needed.
3414 if First_Compiled_File = No_File
3415 and then (Most_Recent_Obj_File = No_File
3416 or else Obj_Stamp > Most_Recent_Obj_Stamp)
3418 Most_Recent_Obj_File := Obj_File;
3419 Most_Recent_Obj_Stamp := Obj_Stamp;
3423 -- Check that switch -x has been used if a source outside
3424 -- of project files need to be compiled.
3426 if Main_Project /= No_Project
3427 and then Arguments_Project = No_Project
3428 and then not External_Unit_Compilation_Allowed
3430 Make_Failed ("external source ("
3431 & Get_Name_String (Source.File)
3432 & ") is not part of any project;"
3433 & " cannot be compiled without"
3434 & " gnatmake switch -x");
3437 -- Is this the first file we have to compile?
3439 if First_Compiled_File = No_File then
3440 First_Compiled_File := Full_Source_File;
3441 Most_Recent_Obj_File := No_File;
3443 if Do_Not_Execute then
3445 -- Exit the main loop
3451 -- Compute where the ALI file must be generated in
3452 -- In_Place_Mode (this does not require to know the
3453 -- location of the object directory).
3455 if In_Place_Mode then
3456 if Full_Lib_File = No_File then
3458 -- If the library file was not found, then save
3459 -- the library file near the source file.
3463 (Full_Source_File, Source.Index);
3464 Full_Lib_File := Lib_File;
3467 -- If the library file was found, then save the
3468 -- library file in the same place.
3470 Lib_File := Full_Lib_File;
3474 -- Start the compilation and record it. We can do this
3475 -- because there is at least one free process. This might
3476 -- change the current directory.
3478 Collect_Arguments_And_Compile
3479 (Full_Source_File => Full_Source_File,
3480 Lib_File => Lib_File,
3481 Source_Index => Source.Index,
3483 Process_Created => Process_Created);
3485 -- Compute where the ALI file will be generated (for
3486 -- cases that might require to know the current
3487 -- directory). The current directory might be changed
3488 -- when compiling other files so we cannot rely on it
3489 -- being the same to find the resulting ALI file.
3491 if not In_Place_Mode then
3493 -- Compute the expected location of the ALI file. This
3494 -- can be from several places:
3495 -- -i => in place mode. In such a case,
3496 -- Full_Lib_File has already been set above
3497 -- -D => if specified
3498 -- or defaults in current dir
3499 -- We could simply use a call similar to
3500 -- Osint.Full_Lib_File_Name (Lib_File)
3501 -- but that involves system calls and is thus slower
3503 if Object_Directory_Path /= null then
3505 Add_Str_To_Name_Buffer (Object_Directory_Path.all);
3506 Add_Str_To_Name_Buffer (Get_Name_String (Lib_File));
3507 Full_Lib_File := Name_Find;
3510 if Project_Of_Current_Object_Directory /=
3514 (Project_Of_Current_Object_Directory
3515 .Object_Directory.Display_Name);
3516 Add_Str_To_Name_Buffer
3517 (Get_Name_String (Lib_File));
3518 Full_Lib_File := Name_Find;
3521 Full_Lib_File := Lib_File;
3527 Lib_File_Attr := Unknown_Attributes;
3529 -- Make sure we could successfully start the compilation
3531 if Process_Created then
3532 if Pid = Invalid_Pid then
3533 Record_Failure (Full_Source_File, Source.Unit);
3537 Sfile => Full_Source_File,
3539 Uname => Source.Unit,
3541 Full_Lib_File => Full_Lib_File,
3542 Lib_File_Attr => Lib_File_Attr);
3550 end Start_Compile_If_Possible;
3552 -----------------------------
3553 -- Wait_For_Available_Slot --
3554 -----------------------------
3556 procedure Wait_For_Available_Slot is
3557 Compilation_OK : Boolean;
3558 Text : Text_Buffer_Ptr;
3560 Data : Compilation_Data;
3563 if Outstanding_Compiles = Max_Process
3564 or else (Queue.Is_Virtually_Empty
3565 and then not Good_ALI_Present
3566 and then Outstanding_Compiles > 0)
3568 Await_Compile (Data, Compilation_OK);
3570 if not Compilation_OK then
3571 Record_Failure (Data.Full_Source_File, Data.Source_Unit);
3574 if Compilation_OK or else Keep_Going then
3576 -- Re-read the updated library file
3579 Saved_Object_Consistency : constant Boolean :=
3580 Check_Object_Consistency;
3583 -- If compilation was not OK, or if output is not an object
3584 -- file and we don't do the bind step, don't check for
3585 -- object consistency.
3587 Check_Object_Consistency :=
3588 Check_Object_Consistency
3590 and (Output_Is_Object or Do_Bind_Step);
3593 Read_Library_Info_From_Full
3594 (Data.Full_Lib_File, Data.Lib_File_Attr'Access);
3596 -- Restore Check_Object_Consistency to its initial value
3598 Check_Object_Consistency := Saved_Object_Consistency;
3601 -- If an ALI file was generated by this compilation, scan the
3602 -- ALI file and record it.
3604 -- If the scan fails, a previous ali file is inconsistent with
3605 -- the unit just compiled.
3607 if Text /= null then
3610 (Data.Lib_File, Text, Ignore_ED => False, Err => True);
3612 if ALI = No_ALI_Id then
3614 -- Record a failure only if not already done
3616 if Compilation_OK then
3619 "incompatible ALI file, please recompile");
3621 (Data.Full_Source_File, Data.Source_Unit);
3625 Record_Good_ALI (ALI, Data.Project);
3630 -- If we could not read the ALI file that was just generated
3631 -- then there could be a problem reading either the ALI or the
3632 -- corresponding object file (if Check_Object_Consistency is
3633 -- set Read_Library_Info checks that the time stamp of the
3634 -- object file is more recent than that of the ALI). However,
3635 -- we record a failure only if not already done.
3638 if Compilation_OK and not Syntax_Only then
3641 "WARNING: ALI or object file not found after compile");
3642 Record_Failure (Data.Full_Source_File, Data.Source_Unit);
3647 end Wait_For_Available_Slot;
3649 -- Start of processing for Compile_Sources
3652 pragma Assert (Args'First = 1);
3654 Outstanding_Compiles := 0;
3655 Running_Compile := new Comp_Data_Arr (1 .. Max_Process);
3657 -- Package and Queue initializations
3661 if Initialize_ALI_Data then
3663 Initialize_ALI_Source;
3666 -- The following two flags affect the behavior of ALI.Set_Source_Table.
3667 -- We set Check_Source_Files to True to ensure that source file time
3668 -- stamps are checked, and we set All_Sources to False to avoid checking
3669 -- the presence of the source files listed in the source dependency
3670 -- section of an ali file (which would be a mistake since the ali file
3671 -- may be obsolete).
3673 Check_Source_Files := True;
3674 All_Sources := False;
3677 ((Format => Format_Gnatmake,
3678 File => Main_Source,
3679 Project => Main_Project,
3680 Unit => No_Unit_Name,
3681 Index => Main_Index));
3683 First_Compiled_File := No_File;
3684 Most_Recent_Obj_File := No_File;
3685 Most_Recent_Obj_Stamp := Empty_Time_Stamp;
3688 -- Keep looping until there is no more work to do (the Q is empty)
3689 -- and all the outstanding compilations have terminated.
3692 while not Queue.Is_Empty or else Outstanding_Compiles > 0 loop
3693 exit Make_Loop when Must_Exit_Because_Of_Error;
3694 exit Make_Loop when Start_Compile_If_Possible (Args);
3696 Wait_For_Available_Slot;
3698 -- ??? Should be done as soon as we add a Good_ALI, wouldn't it avoid
3699 -- the need for a list of good ALI?
3701 Fill_Queue_From_ALI_Files;
3703 if Display_Compilation_Progress then
3704 Write_Str ("completed ");
3705 Write_Int (Int (Queue.Processed));
3706 Write_Str (" out of ");
3707 Write_Int (Int (Queue.Size));
3709 Write_Int (Int ((Queue.Processed * 100) / Queue.Size));
3710 Write_Str ("%)...");
3715 Compilation_Failures := Bad_Compilation_Count;
3717 -- Compilation is finished
3719 -- Delete any temporary configuration pragma file
3721 if not Debug.Debug_Flag_N then
3722 Delete_Temp_Config_Files;
3724 end Compile_Sources;
3726 ----------------------------------
3727 -- Configuration_Pragmas_Switch --
3728 ----------------------------------
3730 function Configuration_Pragmas_Switch
3731 (For_Project : Project_Id) return Argument_List
3733 The_Packages : Package_Id;
3734 Gnatmake : Package_Id;
3735 Compiler : Package_Id;
3737 Global_Attribute : Variable_Value := Nil_Variable_Value;
3738 Local_Attribute : Variable_Value := Nil_Variable_Value;
3740 Global_Attribute_Present : Boolean := False;
3741 Local_Attribute_Present : Boolean := False;
3743 Result : Argument_List (1 .. 3);
3744 Last : Natural := 0;
3746 function Absolute_Path
3747 (Path : Path_Name_Type;
3748 Project : Project_Id) return String;
3749 -- Returns an absolute path for a configuration pragmas file
3755 function Absolute_Path
3756 (Path : Path_Name_Type;
3757 Project : Project_Id) return String
3760 Get_Name_String (Path);
3763 Path_Name : constant String := Name_Buffer (1 .. Name_Len);
3766 if Is_Absolute_Path (Path_Name) then
3771 Parent_Directory : constant String :=
3773 (Project.Directory.Display_Name);
3776 return Parent_Directory & Path_Name;
3782 -- Start of processing for Configuration_Pragmas_Switch
3785 Prj.Env.Create_Config_Pragmas_File
3786 (For_Project, Project_Tree);
3788 if For_Project.Config_File_Name /= No_Path then
3789 Temporary_Config_File := For_Project.Config_File_Temp;
3793 ("-gnatec=" & Get_Name_String (For_Project.Config_File_Name));
3796 Temporary_Config_File := False;
3799 -- Check for attribute Builder'Global_Configuration_Pragmas
3801 The_Packages := Main_Project.Decl.Packages;
3804 (Name => Name_Builder,
3805 In_Packages => The_Packages,
3806 Shared => Project_Tree.Shared);
3808 if Gnatmake /= No_Package then
3809 Global_Attribute := Prj.Util.Value_Of
3810 (Variable_Name => Name_Global_Configuration_Pragmas,
3811 In_Variables => Project_Tree.Shared.Packages.Table
3812 (Gnatmake).Decl.Attributes,
3813 Shared => Project_Tree.Shared);
3814 Global_Attribute_Present :=
3815 Global_Attribute /= Nil_Variable_Value
3816 and then Get_Name_String (Global_Attribute.Value) /= "";
3818 if Global_Attribute_Present then
3820 Path : constant String :=
3822 (Path_Name_Type (Global_Attribute.Value),
3823 Global_Attribute.Project);
3825 if not Is_Regular_File (Path) then
3826 if Debug.Debug_Flag_F then
3828 ("cannot find configuration pragmas file "
3829 & File_Name (Path));
3832 ("cannot find configuration pragmas file " & Path);
3837 Result (Last) := new String'("-gnatec=" & Path);
3842 -- Check for attribute Compiler'Local_Configuration_Pragmas
3844 The_Packages := For_Project.Decl.Packages;
3847 (Name => Name_Compiler,
3848 In_Packages => The_Packages,
3849 Shared => Project_Tree.Shared);
3851 if Compiler /= No_Package then
3852 Local_Attribute := Prj.Util.Value_Of
3853 (Variable_Name => Name_Local_Configuration_Pragmas,
3854 In_Variables => Project_Tree.Shared.Packages.Table
3855 (Compiler).Decl.Attributes,
3856 Shared => Project_Tree.Shared);
3857 Local_Attribute_Present :=
3858 Local_Attribute /= Nil_Variable_Value
3859 and then Get_Name_String (Local_Attribute.Value) /= "";
3861 if Local_Attribute_Present then
3863 Path : constant String :=
3865 (Path_Name_Type (Local_Attribute.Value),
3866 Local_Attribute.Project);
3868 if not Is_Regular_File (Path) then
3869 if Debug.Debug_Flag_F then
3871 ("cannot find configuration pragmas file "
3872 & File_Name (Path));
3876 ("cannot find configuration pragmas file " & Path);
3881 Result (Last) := new String'("-gnatec=" & Path);
3886 return Result (1 .. Last);
3887 end Configuration_Pragmas_Switch;
3893 procedure Debug_Msg (S : String; N : Name_Id) is
3895 if Debug.Debug_Flag_W then
3896 Write_Str (" ... ");
3904 procedure Debug_Msg (S : String; N : File_Name_Type) is
3906 Debug_Msg (S, Name_Id (N));
3909 procedure Debug_Msg (S : String; N : Unit_Name_Type) is
3911 Debug_Msg (S, Name_Id (N));
3914 ---------------------------
3915 -- Delete_All_Temp_Files --
3916 ---------------------------
3918 procedure Delete_All_Temp_Files is
3920 if not Debug.Debug_Flag_N then
3921 Delete_Temp_Config_Files;
3922 Prj.Delete_All_Temp_Files (Project_Tree.Shared);
3924 end Delete_All_Temp_Files;
3926 ------------------------------
3927 -- Delete_Temp_Config_Files --
3928 ------------------------------
3930 procedure Delete_Temp_Config_Files is
3932 Proj : Project_List;
3933 pragma Warnings (Off, Success);
3936 -- The caller is responsible for ensuring that Debug_Flag_N is False
3938 pragma Assert (not Debug.Debug_Flag_N);
3940 if Main_Project /= No_Project then
3941 Proj := Project_Tree.Projects;
3942 while Proj /= null loop
3943 if Proj.Project.Config_File_Temp then
3944 Delete_Temporary_File
3945 (Project_Tree.Shared, Proj.Project.Config_File_Name);
3947 -- Make sure that we don't have a config file for this project,
3948 -- in case there are several mains. In this case, we will
3949 -- recreate another config file: we cannot reuse the one that
3952 Proj.Project.Config_Checked := False;
3953 Proj.Project.Config_File_Name := No_Path;
3954 Proj.Project.Config_File_Temp := False;
3959 end Delete_Temp_Config_Files;
3965 procedure Display (Program : String; Args : Argument_List) is
3967 pragma Assert (Args'First = 1);
3969 if Display_Executed_Programs then
3970 Write_Str (Program);
3972 for J in Args'Range loop
3974 -- Never display -gnatea nor -gnatez
3976 if Args (J).all /= "-gnatea"
3978 Args (J).all /= "-gnatez"
3980 -- Do not display the mapping file argument automatically
3981 -- created when using a project file.
3983 if Main_Project = No_Project
3984 or else Debug.Debug_Flag_N
3985 or else Args (J)'Length < 8
3987 Args (J) (Args (J)'First .. Args (J)'First + 6) /= "-gnatem"
3989 -- When -dn is not specified, do not display the config
3990 -- pragmas switch (-gnatec) for the temporary file created
3991 -- by the project manager (always the first -gnatec switch).
3992 -- Reset Temporary_Config_File to False so that the eventual
3993 -- other -gnatec switches will be displayed.
3995 if (not Debug.Debug_Flag_N)
3996 and then Temporary_Config_File
3997 and then Args (J)'Length > 7
3998 and then Args (J) (Args (J)'First .. Args (J)'First + 6)
4001 Temporary_Config_File := False;
4003 -- Do not display the -F=mapping_file switch for gnatbind
4004 -- if -dn is not specified.
4006 elsif Debug.Debug_Flag_N
4007 or else Args (J)'Length < 4
4009 Args (J) (Args (J)'First .. Args (J)'First + 2) /= "-F="
4013 -- If -df is used, only display file names, not path
4016 if Debug.Debug_Flag_F then
4018 Equal_Pos : Natural;
4020 Equal_Pos := Args (J)'First - 1;
4021 for K in Args (J)'Range loop
4022 if Args (J) (K) = '=' then
4029 (Args (J) (Equal_Pos + 1 .. Args (J)'Last))
4032 (Args (J) (Args (J)'First .. Equal_Pos));
4036 (Equal_Pos + 1 .. Args (J)'Last)));
4039 Write_Str (Args (J).all);
4044 Write_Str (Args (J).all);
4055 ----------------------
4056 -- Display_Commands --
4057 ----------------------
4059 procedure Display_Commands (Display : Boolean := True) is
4061 Display_Executed_Programs := Display;
4062 end Display_Commands;
4064 --------------------------
4065 -- Enter_Into_Obsoleted --
4066 --------------------------
4068 procedure Enter_Into_Obsoleted (F : File_Name_Type) is
4069 Name : constant String := Get_Name_String (F);
4071 F2 : File_Name_Type;
4075 while First > Name'First
4076 and then Name (First - 1) /= Directory_Separator
4077 and then Name (First - 1) /= '/'
4082 if First /= Name'First then
4084 Add_Str_To_Name_Buffer (Name (First .. Name'Last));
4091 Debug_Msg ("New entry in Obsoleted table:", F2);
4092 Obsoleted.Set (F2, True);
4093 end Enter_Into_Obsoleted;
4099 procedure Globalize (Success : out Boolean) is
4100 Quiet_Str : aliased String := "-quiet";
4101 Globalizer_Args : constant Argument_List :=
4102 (1 => Quiet_Str'Unchecked_Access);
4103 Previous_Dir : String_Access;
4105 procedure Globalize_Dir (Dir : String);
4106 -- Call CodePeer globalizer on Dir
4112 procedure Globalize_Dir (Dir : String) is
4115 if Previous_Dir = null or else Dir /= Previous_Dir.all then
4116 Free (Previous_Dir);
4117 Previous_Dir := new String'(Dir);
4119 GNAT.OS_Lib.Spawn (Globalizer_Path.all, Globalizer_Args, Result);
4120 Success := Success and Result;
4124 procedure Globalize_Dirs is new
4125 Prj.Env.For_All_Object_Dirs (Globalize_Dir);
4129 Display (Globalizer, Globalizer_Args);
4131 if Globalizer_Path = null then
4132 Make_Failed ("error, unable to locate " & Globalizer);
4135 if Main_Project = No_Project then
4136 GNAT.OS_Lib.Spawn (Globalizer_Path.all, Globalizer_Args, Success);
4138 Globalize_Dirs (Main_Project, Project_Tree);
4146 procedure Gnatmake is
4147 Main_Source_File : File_Name_Type;
4148 -- The source file containing the main compilation unit
4150 Compilation_Failures : Natural;
4152 Total_Compilation_Failures : Natural := 0;
4154 Is_Main_Unit : Boolean;
4155 -- Set True by Compile_Sources if Main_Source_File can be a main unit
4157 Main_ALI_File : File_Name_Type;
4158 -- The ali file corresponding to Main_Source_File
4160 Executable : File_Name_Type := No_File;
4161 -- The file name of an executable
4163 Non_Std_Executable : Boolean := False;
4164 -- Non_Std_Executable is set to True when there is a possibility that
4165 -- the linker will not choose the correct executable file name.
4167 Current_Work_Dir : constant String_Access :=
4168 new String'(Get_Current_Dir);
4169 -- The current working directory, used to modify some relative path
4170 -- switches on the command line when a project file is used.
4172 Current_Main_Index : Int := 0;
4173 -- If not zero, the index of the current main unit in its source file
4175 Stand_Alone_Libraries : Boolean := False;
4176 -- Set to True when there are Stand-Alone Libraries, so that gnatbind
4177 -- is invoked with the -F switch to force checking of elaboration flags.
4179 Mapping_Path : Path_Name_Type := No_Path;
4180 -- The path name of the mapping file
4182 Project_Node_Tree : Project_Node_Tree_Ref;
4183 Root_Environment : Prj.Tree.Environment;
4186 pragma Warnings (Off, Discard);
4188 procedure Check_Mains;
4189 -- Check that the main subprograms do exist and that they all
4190 -- belong to the same project file.
4196 procedure Check_Mains is
4197 Real_Main_Project : Project_Id := No_Project;
4198 -- The project of the first main
4200 Proj : Project_Id := No_Project;
4201 -- The project of the current main
4203 Real_Path : String_Access;
4212 Main : constant String := Mains.Next_Main;
4213 -- The name specified on the command line may include directory
4216 File_Name : constant String := Base_Name (Main);
4217 -- The simple file name of the current main
4219 Lang : Language_Ptr;
4222 exit when Main = "";
4224 -- Get the project of the current main
4226 Proj := Prj.Env.Project_Of
4227 (File_Name, Main_Project, Project_Tree);
4229 -- Fail if the current main is not a source of a project
4231 if Proj = No_Project then
4233 ("""" & Main & """ is not a source of any project");
4236 -- If there is directory information, check that the source
4237 -- exists and, if it does, that the path is the actual path
4238 -- of a source of a project.
4240 if Main /= File_Name then
4241 Lang := Get_Language_From_Name (Main_Project, "ada");
4245 (Main & Get_Name_String
4246 (Lang.Config.Naming_Data.Body_Suffix),
4248 if Real_Path = null then
4251 (Main & Get_Name_String
4252 (Lang.Config.Naming_Data.Spec_Suffix),
4256 if Real_Path = null then
4257 Real_Path := Locate_Regular_File (Main, "");
4260 -- Fail if the file cannot be found
4262 if Real_Path = null then
4263 Make_Failed ("file """ & Main & """ does not exist");
4267 Project_Path : constant String :=
4268 Prj.Env.File_Name_Of_Library_Unit_Body
4270 Project => Main_Project,
4271 In_Tree => Project_Tree,
4272 Main_Project_Only => False,
4274 Normed_Path : constant String :=
4277 Case_Sensitive => False);
4278 Proj_Path : constant String :=
4281 Case_Sensitive => False);
4286 -- Fail if it is not the correct path
4288 if Normed_Path /= Proj_Path then
4289 if Verbose_Mode then
4291 Write_Str (Normed_Path);
4293 Write_Line (Proj_Path);
4298 """ is not a source of any project");
4303 if not Unique_Compile then
4305 -- Record the project, if it is the first main
4307 if Real_Main_Project = No_Project then
4308 Real_Main_Project := Proj;
4310 elsif Proj /= Real_Main_Project then
4312 -- Fail, as the current main is not a source of the
4313 -- same project as the first main.
4317 """ is not a source of project " &
4318 Get_Name_String (Real_Main_Project.Name));
4323 -- If -u and -U are not used, we may have mains that are
4324 -- sources of a project that is not the one specified with
4327 if not Unique_Compile then
4328 Main_Project := Real_Main_Project;
4334 -- Start of processing for Gnatmake
4336 -- This body is very long, should be broken down???
4339 Install_Int_Handler (Sigint_Intercepted'Access);
4341 Do_Compile_Step := True;
4342 Do_Bind_Step := True;
4343 Do_Link_Step := True;
4347 Make.Initialize (Project_Node_Tree, Root_Environment);
4349 Bind_Shared := No_Shared_Switch'Access;
4350 Link_With_Shared_Libgcc := No_Shared_Libgcc_Switch'Access;
4352 Failed_Links.Set_Last (0);
4353 Successful_Links.Set_Last (0);
4355 -- Special case when switch -B was specified
4357 if Build_Bind_And_Link_Full_Project then
4359 -- When switch -B is specified, there must be a project file
4361 if Main_Project = No_Project then
4362 Make_Failed ("-B cannot be used without a project file");
4364 -- No main program may be specified on the command line
4366 elsif Osint.Number_Of_Files /= 0 then
4367 Make_Failed ("-B cannot be used with a main specified on " &
4368 "the command line");
4370 -- And the project file cannot be a library project file
4372 elsif Main_Project.Library then
4373 Make_Failed ("-B cannot be used for a library project file");
4376 No_Main_Subprogram := True;
4377 Insert_Project_Sources
4378 (The_Project => Main_Project,
4379 All_Projects => Unique_Compile_All_Projects,
4382 -- If there are no sources to compile, we fail
4384 if Osint.Number_Of_Files = 0 then
4385 Make_Failed ("no sources to compile");
4388 -- Specify -n for gnatbind and add the ALI files of all the
4389 -- sources, except the one which is a fake main subprogram: this
4390 -- is the one for the binder generated file and it will be
4391 -- transmitted to gnatlink. These sources are those that are in
4394 Add_Switch ("-n", Binder, And_Save => True);
4396 for J in 1 .. Queue.Size loop
4399 (Lib_File_Name (Queue.Element (J))),
4400 Binder, And_Save => True);
4404 elsif Main_Index /= 0 and then Osint.Number_Of_Files > 1 then
4405 Make_Failed ("cannot specify several mains with a multi-unit index");
4407 elsif Main_Project /= No_Project then
4409 -- If the main project file is a library project file, main(s) cannot
4410 -- be specified on the command line.
4412 if Osint.Number_Of_Files /= 0 then
4413 if Main_Project.Library
4414 and then not Unique_Compile
4415 and then ((not Make_Steps) or else Bind_Only or else Link_Only)
4417 Make_Failed ("cannot specify a main program " &
4418 "on the command line for a library project file");
4421 -- Check that each main on the command line is a source of a
4422 -- project file and, if there are several mains, each of them
4423 -- is a source of the same project file.
4428 -- If no mains have been specified on the command line, and we are
4429 -- using a project file, we either find the main(s) in attribute Main
4430 -- of the main project, or we put all the sources of the project file
4434 if Main_Index /= 0 then
4435 Make_Failed ("cannot specify a multi-unit index but no main " &
4436 "on the command line");
4440 Value : String_List_Id := Main_Project.Mains;
4443 -- The attribute Main is an empty list or not specified, or
4444 -- else gnatmake was invoked with the switch "-u".
4446 if Value = Prj.Nil_String or else Unique_Compile then
4448 if (not Make_Steps) or else Compile_Only
4449 or else not Main_Project.Library
4451 -- First make sure that the binder and the linker will
4454 Do_Bind_Step := False;
4455 Do_Link_Step := False;
4457 -- Put all the sources in the queue
4459 No_Main_Subprogram := True;
4460 Insert_Project_Sources
4461 (The_Project => Main_Project,
4462 All_Projects => Unique_Compile_All_Projects,
4465 -- If no sources to compile, then there is nothing to do
4467 if Osint.Number_Of_Files = 0 then
4468 if not Quiet_Output then
4469 Osint.Write_Program_Name;
4470 Write_Line (": no sources to compile");
4473 Delete_All_Temp_Files;
4474 Exit_Program (E_Success);
4479 -- The attribute Main is not an empty list. Put all the main
4480 -- subprograms in the list as if they were specified on the
4481 -- command line. However, if attribute Languages includes a
4482 -- language other than Ada, only include the Ada mains; if
4483 -- there is no Ada main, compile all sources of the project.
4486 Languages : constant Variable_Value :=
4489 Main_Project.Decl.Attributes,
4490 Project_Tree.Shared);
4492 Current : String_List_Id;
4493 Element : String_Element;
4495 Foreign_Language : Boolean := False;
4496 At_Least_One_Main : Boolean := False;
4499 -- First, determine if there is a foreign language in
4500 -- attribute Languages.
4502 if not Languages.Default then
4503 Current := Languages.Values;
4505 while Current /= Nil_String loop
4506 Element := Project_Tree.Shared.String_Elements.
4508 Get_Name_String (Element.Value);
4509 To_Lower (Name_Buffer (1 .. Name_Len));
4511 if Name_Buffer (1 .. Name_Len) /= "ada" then
4512 Foreign_Language := True;
4513 exit Look_For_Foreign;
4516 Current := Element.Next;
4517 end loop Look_For_Foreign;
4520 -- Then, find all mains, or if there is a foreign
4521 -- language, all the Ada mains.
4523 while Value /= Prj.Nil_String loop
4524 -- To know if a main is an Ada main, get its project.
4525 -- It should be the project specified on the command
4529 (Project_Tree.Shared.String_Elements.Table
4533 Main_Name : constant String :=
4535 (Project_Tree.Shared.String_Elements.Table
4537 Proj : constant Project_Id :=
4539 (Main_Name, Main_Project, Project_Tree);
4542 if Proj = Main_Project then
4544 At_Least_One_Main := True;
4547 (Project_Tree.Shared.String_Elements.Table
4550 Project_Tree.Shared.String_Elements.Table
4553 elsif not Foreign_Language then
4556 """ is not a source of project " &
4557 Get_Name_String (Main_Project.Display_Name));
4561 Value := Project_Tree.Shared.String_Elements.Table
4565 -- If we did not get any main, it means that all mains
4566 -- in attribute Mains are in a foreign language and -B
4567 -- was not specified to gnatmake; so, we fail.
4569 if not At_Least_One_Main then
4571 ("no Ada mains, use -B to build foreign main");
4580 if Verbose_Mode then
4582 Display_Version ("GNATMAKE", "1995");
4585 if Osint.Number_Of_Files = 0 then
4586 if Main_Project /= No_Project
4587 and then Main_Project.Library
4590 and then not Main_Project.Standalone_Library
4592 Make_Failed ("only stand-alone libraries may be bound");
4595 -- Add the default search directories to be able to find libgnat
4597 Osint.Add_Default_Search_Dirs;
4599 -- Get the target parameters, so that the correct binder generated
4600 -- files are generated if OpenVMS is the target.
4603 Targparm.Get_Target_Parameters;
4606 when Unrecoverable_Error =>
4607 Make_Failed ("*** make failed.");
4610 -- And bind and or link the library
4612 MLib.Prj.Build_Library
4613 (For_Project => Main_Project,
4614 In_Tree => Project_Tree,
4615 Gnatbind => Gnatbind.all,
4616 Gnatbind_Path => Gnatbind_Path,
4618 Gcc_Path => Gcc_Path,
4622 Delete_All_Temp_Files;
4623 Exit_Program (E_Success);
4626 -- Call Get_Target_Parameters to ensure that VM_Target and
4627 -- AAMP_On_Target get set before calling Usage.
4629 Targparm.Get_Target_Parameters;
4631 -- Output usage information if no files to compile
4634 Exit_Program (E_Fatal);
4638 -- If -M was specified, behave as if -n was specified
4640 if List_Dependencies then
4641 Do_Not_Execute := True;
4644 -- Note that Osint.M.Next_Main_Source will always return the (possibly
4645 -- abbreviated file) without any directory information.
4647 Main_Source_File := Next_Main_Source;
4649 if Current_File_Index /= No_Index then
4650 Main_Index := Current_File_Index;
4653 Add_Switch ("-I-", Compiler, And_Save => True);
4655 if Main_Project = No_Project then
4656 if Look_In_Primary_Dir then
4660 Normalize_Directory_Name
4661 (Get_Primary_Src_Search_Directory.all).all,
4662 Compiler, Append_Switch => False,
4668 -- If we use a project file, we have already checked that a main
4669 -- specified on the command line with directory information has the
4670 -- path name corresponding to a correct source in the project tree.
4671 -- So, we don't need the directory information to be taken into
4672 -- account by Find_File, and in fact it may lead to take the wrong
4673 -- sources for other compilation units, when there are extending
4676 Look_In_Primary_Dir := False;
4677 Add_Switch ("-I-", Binder, And_Save => True);
4680 -- If the user wants a program without a main subprogram, add the
4681 -- appropriate switch to the binder.
4683 if No_Main_Subprogram then
4684 Add_Switch ("-z", Binder, And_Save => True);
4687 if Main_Project /= No_Project then
4689 if Main_Project.Object_Directory /= No_Path_Information then
4690 -- Change current directory to object directory of main project
4692 Project_Of_Current_Object_Directory := No_Project;
4693 Change_To_Object_Directory (Main_Project);
4696 -- Source file lookups should be cached for efficiency.
4697 -- Source files are not supposed to change.
4699 Osint.Source_File_Data (Cache => True);
4701 -- Find the file name of the (first) main unit
4704 Main_Source_File_Name : constant String :=
4705 Get_Name_String (Main_Source_File);
4706 Main_Unit_File_Name : constant String :=
4707 Prj.Env.File_Name_Of_Library_Unit_Body
4708 (Name => Main_Source_File_Name,
4709 Project => Main_Project,
4710 In_Tree => Project_Tree,
4711 Main_Project_Only =>
4712 not Unique_Compile);
4714 The_Packages : constant Package_Id :=
4715 Main_Project.Decl.Packages;
4717 Builder_Package : constant Prj.Package_Id :=
4719 (Name => Name_Builder,
4720 In_Packages => The_Packages,
4721 Shared => Project_Tree.Shared);
4723 Binder_Package : constant Prj.Package_Id :=
4725 (Name => Name_Binder,
4726 In_Packages => The_Packages,
4727 Shared => Project_Tree.Shared);
4729 Linker_Package : constant Prj.Package_Id :=
4731 (Name => Name_Linker,
4732 In_Packages => The_Packages,
4733 Shared => Project_Tree.Shared);
4735 Default_Switches_Array : Array_Id;
4737 Global_Compilation_Array : Array_Element_Id;
4738 Global_Compilation_Elem : Array_Element;
4739 Global_Compilation_Switches : Variable_Value;
4742 -- We fail if we cannot find the main source file
4744 if Main_Unit_File_Name = "" then
4745 Make_Failed ('"' & Main_Source_File_Name
4746 & """ is not a unit of project "
4747 & Project_File_Name.all & ".");
4749 -- Remove any directory information from the main source file
4753 Pos : Natural := Main_Unit_File_Name'Last;
4757 exit when Pos < Main_Unit_File_Name'First or else
4758 Main_Unit_File_Name (Pos) = Directory_Separator;
4762 Name_Len := Main_Unit_File_Name'Last - Pos;
4764 Name_Buffer (1 .. Name_Len) :=
4766 (Pos + 1 .. Main_Unit_File_Name'Last);
4768 Main_Source_File := Name_Find;
4770 -- We only output the main source file if there is only one
4772 if Verbose_Mode and then Osint.Number_Of_Files = 1 then
4773 Write_Str ("Main source file: """);
4774 Write_Str (Main_Unit_File_Name
4775 (Pos + 1 .. Main_Unit_File_Name'Last));
4781 -- If there is a package Builder in the main project file, add
4782 -- the switches from it.
4784 if Builder_Package /= No_Package then
4786 Global_Compilation_Array := Prj.Util.Value_Of
4787 (Name => Name_Global_Compilation_Switches,
4788 In_Arrays => Project_Tree.Shared.Packages.Table
4789 (Builder_Package).Decl.Arrays,
4790 Shared => Project_Tree.Shared);
4792 Default_Switches_Array :=
4793 Project_Tree.Shared.Packages.Table
4794 (Builder_Package).Decl.Arrays;
4796 while Default_Switches_Array /= No_Array and then
4797 Project_Tree.Shared.Arrays.Table (Default_Switches_Array).Name
4798 /= Name_Default_Switches
4800 Default_Switches_Array := Project_Tree.Shared.Arrays.Table
4801 (Default_Switches_Array).Next;
4804 if Global_Compilation_Array /= No_Array_Element and then
4805 Default_Switches_Array /= No_Array
4808 ("Default_Switches forbidden in presence of " &
4809 "Global_Compilation_Switches. Use Switches instead.",
4810 Project_Tree.Shared.Arrays.Table
4811 (Default_Switches_Array).Location);
4814 ("*** illegal combination of Builder attributes");
4817 -- If there is only one main, we attempt to get the gnatmake
4818 -- switches for this main (if any). If there are no specific
4819 -- switch for this particular main, get the general gnatmake
4820 -- switches (if any).
4822 if Osint.Number_Of_Files = 1 then
4823 if Verbose_Mode then
4824 Write_Str ("Adding gnatmake switches for """);
4825 Write_Str (Main_Unit_File_Name);
4830 (Project_Node_Tree => Project_Node_Tree,
4831 Env => Root_Environment,
4832 File_Name => Main_Unit_File_Name,
4833 Index => Main_Index,
4834 The_Package => Builder_Package,
4836 Unknown_Switches_To_The_Compiler =>
4837 Global_Compilation_Array = No_Array_Element);
4840 -- If there are several mains, we always get the general
4841 -- gnatmake switches (if any).
4843 -- Warn the user, if necessary, so that he is not surprised
4844 -- that specific switches are not taken into account.
4847 Defaults : constant Variable_Value :=
4851 Attribute_Or_Array_Name =>
4852 Name_Default_Switches,
4855 Shared => Project_Tree.Shared);
4857 Switches : constant Array_Element_Id :=
4859 (Name => Name_Switches,
4861 Project_Tree.Shared.Packages.Table
4862 (Builder_Package).Decl.Arrays,
4863 Shared => Project_Tree.Shared);
4865 Other_Switches : constant Variable_Value :=
4867 (Name => All_Other_Names,
4869 Attribute_Or_Array_Name
4871 In_Package => Builder_Package,
4872 Shared => Project_Tree.Shared);
4875 if Other_Switches /= Nil_Variable_Value then
4877 and then Switches /= No_Array_Element
4878 and then Project_Tree.Shared.Array_Elements.Table
4879 (Switches).Next /= No_Array_Element
4882 ("Warning: using Builder'Switches(others), "
4883 & "as there are several mains");
4887 (Project_Node_Tree => Project_Node_Tree,
4888 Env => Root_Environment,
4891 The_Package => Builder_Package,
4893 Unknown_Switches_To_The_Compiler => False);
4895 elsif Defaults /= Nil_Variable_Value then
4897 and then Switches /= No_Array_Element
4900 ("Warning: using Builder'Default_Switches"
4901 & "(""Ada""), as there are several mains");
4905 (Project_Node_Tree => Project_Node_Tree,
4906 Env => Root_Environment,
4909 The_Package => Builder_Package,
4912 elsif not Quiet_Output
4913 and then Switches /= No_Array_Element
4916 ("Warning: using no switches from package "
4917 & "Builder, as there are several mains");
4922 -- Take into account attribute Global_Compilation_Switches
4927 List : String_List_Id;
4928 Elem : String_Element;
4931 while Global_Compilation_Array /= No_Array_Element loop
4932 Global_Compilation_Elem :=
4933 Project_Tree.Shared.Array_Elements.Table
4934 (Global_Compilation_Array);
4936 Get_Name_String (Global_Compilation_Elem.Index);
4937 To_Lower (Name_Buffer (1 .. Name_Len));
4940 if Index = Name_Ada then
4941 Global_Compilation_Switches :=
4942 Global_Compilation_Elem.Value;
4944 if Global_Compilation_Switches /= Nil_Variable_Value
4945 and then not Global_Compilation_Switches.Default
4947 -- We have found attribute
4948 -- Global_Compilation_Switches ("Ada"): put the
4949 -- switches in the appropriate table.
4951 List := Global_Compilation_Switches.Values;
4953 while List /= Nil_String loop
4955 Project_Tree.Shared.String_Elements.Table
4958 if Elem.Value /= No_Name then
4960 (Get_Name_String (Elem.Value),
4972 Global_Compilation_Array := Global_Compilation_Elem.Next;
4977 Osint.Add_Default_Search_Dirs;
4979 -- Record the current last switch index for table Binder_Switches
4980 -- and Linker_Switches, so that these tables may be reset before
4981 -- for each main, before adding switches from the project file
4982 -- and from the command line.
4984 Last_Binder_Switch := Binder_Switches.Last;
4985 Last_Linker_Switch := Linker_Switches.Last;
4989 -- Add binder switches from the project file for the first main
4991 if Do_Bind_Step and then Binder_Package /= No_Package then
4992 if Verbose_Mode then
4993 Write_Str ("Adding binder switches for """);
4994 Write_Str (Main_Unit_File_Name);
4999 (Project_Node_Tree => Project_Node_Tree,
5000 Env => Root_Environment,
5001 File_Name => Main_Unit_File_Name,
5002 Index => Main_Index,
5003 The_Package => Binder_Package,
5007 -- Add linker switches from the project file for the first main
5009 if Do_Link_Step and then Linker_Package /= No_Package then
5010 if Verbose_Mode then
5011 Write_Str ("Adding linker switches for""");
5012 Write_Str (Main_Unit_File_Name);
5017 (Project_Node_Tree => Project_Node_Tree,
5018 Env => Root_Environment,
5019 File_Name => Main_Unit_File_Name,
5020 Index => Main_Index,
5021 The_Package => Linker_Package,
5027 -- The combination of -f -u and one or several mains on the command line
5030 if Force_Compilations
5031 and then Unique_Compile
5032 and then not Unique_Compile_All_Projects
5033 and then Main_On_Command_Line
5035 Must_Compile := True;
5038 if Main_Project /= No_Project
5039 and then not Must_Compile
5040 and then Main_Project.Externally_Built
5043 ("nothing to do for a main project that is externally built");
5046 -- Get the target parameters, which are only needed for a couple of
5047 -- cases in gnatmake. Protect against an exception, such as the case of
5048 -- system.ads missing from the library, and fail gracefully.
5051 Targparm.Get_Target_Parameters;
5053 when Unrecoverable_Error =>
5054 Make_Failed ("*** make failed.");
5057 -- Special processing for VM targets
5059 if Targparm.VM_Target /= No_VM then
5061 -- Set proper processing commands
5063 case Targparm.VM_Target is
5064 when Targparm.JVM_Target =>
5066 -- Do not check for an object file (".o") when compiling to
5067 -- JVM machine since ".class" files are generated instead.
5069 Check_Object_Consistency := False;
5070 Gcc := new String'("jvm-gnatcompile");
5072 when Targparm.CLI_Target =>
5073 Gcc := new String'("dotnet-gnatcompile");
5075 when Targparm.No_VM =>
5076 raise Program_Error;
5080 Display_Commands (not Quiet_Output);
5084 if Main_Project /= No_Project then
5086 -- For all library project, if the library file does not exist, put
5087 -- all the project sources in the queue, and flag the project so that
5088 -- the library is generated.
5090 if not Unique_Compile
5091 and then MLib.Tgt.Support_For_Libraries /= Prj.None
5094 Proj : Project_List;
5097 Proj := Project_Tree.Projects;
5098 while Proj /= null loop
5099 if Proj.Project.Library then
5100 Proj.Project.Need_To_Build_Lib :=
5101 not MLib.Tgt.Library_Exists_For
5102 (Proj.Project, Project_Tree)
5103 and then not Proj.Project.Externally_Built;
5105 if Proj.Project.Need_To_Build_Lib then
5107 -- If there is no object directory, then it will be
5108 -- impossible to build the library. So fail
5112 Proj.Project.Object_Directory = No_Path_Information
5115 ("no object files to build library for project """
5116 & Get_Name_String (Proj.Project.Name)
5118 Proj.Project.Need_To_Build_Lib := False;
5121 if Verbose_Mode then
5123 ("Library file does not exist for project """);
5124 Write_Str (Get_Name_String (Proj.Project.Name));
5128 Insert_Project_Sources
5129 (The_Project => Proj.Project,
5130 All_Projects => False,
5141 -- If a relative path output file has been specified, we add the
5144 for J in reverse 1 .. Saved_Linker_Switches.Last - 1 loop
5145 if Saved_Linker_Switches.Table (J).all = Output_Flag.all then
5147 Exec_File_Name : constant String :=
5148 Saved_Linker_Switches.Table (J + 1).all;
5151 if not Is_Absolute_Path (Exec_File_Name) then
5153 (Main_Project.Exec_Directory.Display_Name);
5154 Add_Str_To_Name_Buffer (Exec_File_Name);
5155 Saved_Linker_Switches.Table (J + 1) :=
5156 new String'(Name_Buffer (1 .. Name_Len));
5164 -- If we are using a project file, for relative paths we add the
5165 -- current working directory for any relative path on the command
5166 -- line and the project directory, for any relative path in the
5170 Dir_Path : constant String :=
5171 Get_Name_String (Main_Project.Directory.Display_Name);
5173 for J in 1 .. Binder_Switches.Last loop
5174 Test_If_Relative_Path
5175 (Binder_Switches.Table (J),
5176 Do_Fail => Make_Failed'Access,
5177 Parent => Dir_Path, Including_L_Switch => False);
5180 for J in 1 .. Saved_Binder_Switches.Last loop
5181 Test_If_Relative_Path
5182 (Saved_Binder_Switches.Table (J),
5183 Do_Fail => Make_Failed'Access,
5184 Parent => Current_Work_Dir.all, Including_L_Switch => False);
5187 for J in 1 .. Linker_Switches.Last loop
5188 Test_If_Relative_Path
5189 (Linker_Switches.Table (J), Parent => Dir_Path,
5190 Do_Fail => Make_Failed'Access);
5193 for J in 1 .. Saved_Linker_Switches.Last loop
5194 Test_If_Relative_Path
5195 (Saved_Linker_Switches.Table (J),
5196 Do_Fail => Make_Failed'Access,
5197 Parent => Current_Work_Dir.all);
5200 for J in 1 .. Gcc_Switches.Last loop
5201 Test_If_Relative_Path
5202 (Gcc_Switches.Table (J),
5203 Do_Fail => Make_Failed'Access,
5205 Including_Non_Switch => False);
5208 for J in 1 .. Saved_Gcc_Switches.Last loop
5209 Test_If_Relative_Path
5210 (Saved_Gcc_Switches.Table (J),
5211 Parent => Current_Work_Dir.all,
5212 Do_Fail => Make_Failed'Access,
5213 Including_Non_Switch => False);
5218 -- We now put in the Binder_Switches and Linker_Switches tables, the
5219 -- binder and linker switches of the command line that have been put in
5220 -- the Saved_ tables. If a project file was used, then the command line
5221 -- switches will follow the project file switches.
5223 for J in 1 .. Saved_Binder_Switches.Last loop
5225 (Saved_Binder_Switches.Table (J),
5230 for J in 1 .. Saved_Linker_Switches.Last loop
5232 (Saved_Linker_Switches.Table (J),
5237 -- If no project file is used, we just put the gcc switches
5238 -- from the command line in the Gcc_Switches table.
5240 if Main_Project = No_Project then
5241 for J in 1 .. Saved_Gcc_Switches.Last loop
5243 (Saved_Gcc_Switches.Table (J), Compiler, And_Save => False);
5247 -- If there is a project, put the command line gcc switches in the
5248 -- variable The_Saved_Gcc_Switches. They are going to be used later
5249 -- in procedure Compile_Sources.
5251 The_Saved_Gcc_Switches :=
5252 new Argument_List (1 .. Saved_Gcc_Switches.Last + 1);
5254 for J in 1 .. Saved_Gcc_Switches.Last loop
5255 The_Saved_Gcc_Switches (J) := Saved_Gcc_Switches.Table (J);
5258 -- We never use gnat.adc when a project file is used
5260 The_Saved_Gcc_Switches (The_Saved_Gcc_Switches'Last) := No_gnat_adc;
5263 -- If there was a --GCC, --GNATBIND or --GNATLINK switch on the command
5264 -- line, then we have to use it, even if there was another switch in
5265 -- the project file.
5267 if Saved_Gcc /= null then
5271 if Saved_Gnatbind /= null then
5272 Gnatbind := Saved_Gnatbind;
5275 if Saved_Gnatlink /= null then
5276 Gnatlink := Saved_Gnatlink;
5279 Gcc_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all);
5280 Gnatbind_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatbind.all);
5281 Gnatlink_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatlink.all);
5283 -- If we have specified -j switch both from the project file
5284 -- and on the command line, the one from the command line takes
5287 if Saved_Maximum_Processes = 0 then
5288 Saved_Maximum_Processes := Maximum_Processes;
5291 if Debug.Debug_Flag_M then
5292 Write_Line ("Maximum number of simultaneous compilations =" &
5293 Saved_Maximum_Processes'Img);
5296 -- Allocate as many temporary mapping file names as the maximum number
5297 -- of compilations processed, for each possible project.
5300 Data : Project_Compilation_Access;
5301 Proj : Project_List := Project_Tree.Projects;
5303 while Proj /= null loop
5304 Data := new Project_Compilation_Data'
5305 (Mapping_File_Names => new Temp_Path_Names
5306 (1 .. Saved_Maximum_Processes),
5307 Last_Mapping_File_Names => 0,
5308 Free_Mapping_File_Indexes => new Free_File_Indexes
5309 (1 .. Saved_Maximum_Processes),
5310 Last_Free_Indexes => 0);
5312 Project_Compilation_Htable.Set
5313 (Project_Compilation, Proj.Project, Data);
5317 Data := new Project_Compilation_Data'
5318 (Mapping_File_Names => new Temp_Path_Names
5319 (1 .. Saved_Maximum_Processes),
5320 Last_Mapping_File_Names => 0,
5321 Free_Mapping_File_Indexes => new Free_File_Indexes
5322 (1 .. Saved_Maximum_Processes),
5323 Last_Free_Indexes => 0);
5325 Project_Compilation_Htable.Set
5326 (Project_Compilation, No_Project, Data);
5329 Bad_Compilation.Init;
5331 -- If project files are used, create the mapping of all the sources, so
5332 -- that the correct paths will be found. Otherwise, if there is a file
5333 -- which is not a source with the same name in a source directory this
5334 -- file may be incorrectly found.
5336 if Main_Project /= No_Project then
5337 Prj.Env.Create_Mapping (Project_Tree);
5340 Current_Main_Index := Main_Index;
5342 -- Here is where the make process is started
5344 -- We do the same process for each main
5346 Multiple_Main_Loop : for N_File in 1 .. Osint.Number_Of_Files loop
5348 -- First, find the executable name and path
5350 Executable := No_File;
5351 Executable_Obsolete := False;
5352 Non_Std_Executable :=
5353 Targparm.Executable_Extension_On_Target /= No_Name;
5355 -- Look inside the linker switches to see if the name of the final
5356 -- executable program was specified.
5358 for J in reverse Linker_Switches.First .. Linker_Switches.Last loop
5359 if Linker_Switches.Table (J).all = Output_Flag.all then
5360 pragma Assert (J < Linker_Switches.Last);
5362 -- We cannot specify a single executable for several main
5365 if Osint.Number_Of_Files > 1 then
5367 ("cannot specify a single executable for several mains");
5371 Add_Str_To_Name_Buffer (Linker_Switches.Table (J + 1).all);
5372 Executable := Name_Enter;
5374 Verbose_Msg (Executable, "final executable");
5378 -- If the name of the final executable program was not specified then
5379 -- construct it from the main input file.
5381 if Executable = No_File then
5382 if Main_Project = No_Project then
5383 Executable := Executable_Name (Strip_Suffix (Main_Source_File));
5386 -- If we are using a project file, we attempt to remove the
5387 -- body (or spec) termination of the main subprogram. We find
5388 -- it the naming scheme of the project file. This avoids
5389 -- generating an executable "main.2" for a main subprogram
5390 -- "main.2.ada", when the body termination is ".2.ada".
5393 Prj.Util.Executable_Of
5394 (Main_Project, Project_Tree.Shared,
5395 Main_Source_File, Main_Index);
5399 if Main_Project /= No_Project
5400 and then Main_Project.Exec_Directory /= No_Path_Information
5403 Exec_File_Name : constant String :=
5404 Get_Name_String (Executable);
5407 if not Is_Absolute_Path (Exec_File_Name) then
5408 Get_Name_String (Main_Project.Exec_Directory.Display_Name);
5409 Add_Str_To_Name_Buffer (Exec_File_Name);
5410 Executable := Name_Find;
5413 Non_Std_Executable := True;
5417 if Do_Compile_Step then
5418 Recursive_Compilation_Step : declare
5419 Args : Argument_List (1 .. Gcc_Switches.Last);
5421 First_Compiled_File : File_Name_Type;
5422 Youngest_Obj_File : File_Name_Type;
5423 Youngest_Obj_Stamp : Time_Stamp_Type;
5425 Executable_Stamp : Time_Stamp_Type;
5426 -- Executable is the final executable program
5427 -- ??? comment seems unrelated to declaration
5429 Library_Rebuilt : Boolean := False;
5432 for J in 1 .. Gcc_Switches.Last loop
5433 Args (J) := Gcc_Switches.Table (J);
5437 (Main_Project /= No_Project and then
5438 One_Compilation_Per_Obj_Dir);
5440 -- Now we invoke Compile_Sources for the current main
5443 (Main_Source => Main_Source_File,
5445 First_Compiled_File => First_Compiled_File,
5446 Most_Recent_Obj_File => Youngest_Obj_File,
5447 Most_Recent_Obj_Stamp => Youngest_Obj_Stamp,
5448 Main_Unit => Is_Main_Unit,
5449 Main_Index => Current_Main_Index,
5450 Compilation_Failures => Compilation_Failures,
5451 Check_Readonly_Files => Check_Readonly_Files,
5452 Do_Not_Execute => Do_Not_Execute,
5453 Force_Compilations => Force_Compilations,
5454 In_Place_Mode => In_Place_Mode,
5455 Keep_Going => Keep_Going,
5456 Initialize_ALI_Data => True,
5457 Max_Process => Saved_Maximum_Processes);
5459 if Verbose_Mode then
5460 Write_Str ("End of compilation");
5464 Total_Compilation_Failures :=
5465 Total_Compilation_Failures + Compilation_Failures;
5467 if Total_Compilation_Failures /= 0 then
5472 List_Bad_Compilations;
5473 Report_Compilation_Failed;
5477 -- Regenerate libraries, if there are any and if object files
5478 -- have been regenerated.
5480 if Main_Project /= No_Project
5481 and then MLib.Tgt.Support_For_Libraries /= Prj.None
5482 and then (Do_Bind_Step
5483 or Unique_Compile_All_Projects
5484 or not Compile_Only)
5485 and then (Do_Link_Step or else N_File = Osint.Number_Of_Files)
5492 Proj1 : Project_List;
5494 procedure Add_To_Library_Projs (Proj : Project_Id);
5495 -- Add project Project to table Library_Projs in
5496 -- decreasing depth order.
5498 --------------------------
5499 -- Add_To_Library_Projs --
5500 --------------------------
5502 procedure Add_To_Library_Projs (Proj : Project_Id) is
5506 Library_Projs.Increment_Last;
5507 Depth := Proj.Depth;
5509 -- Put the projects in decreasing depth order, so that
5510 -- if libA depends on libB, libB is first in order.
5512 Current := Library_Projs.Last;
5513 while Current > 1 loop
5514 Prj := Library_Projs.Table (Current - 1);
5515 exit when Prj.Depth >= Depth;
5516 Library_Projs.Table (Current) := Prj;
5517 Current := Current - 1;
5520 Library_Projs.Table (Current) := Proj;
5521 end Add_To_Library_Projs;
5523 -- Start of processing for ??? (should name declare block
5524 -- or probably better, break this out as a nested proc).
5527 -- Put in Library_Projs table all library project file
5528 -- ids when the library need to be rebuilt.
5530 Proj1 := Project_Tree.Projects;
5531 while Proj1 /= null loop
5532 if Proj1.Project.Standalone_Library then
5533 Stand_Alone_Libraries := True;
5536 if Proj1.Project.Library then
5537 MLib.Prj.Check_Library
5538 (Proj1.Project, Project_Tree);
5541 if Proj1.Project.Need_To_Build_Lib then
5542 Add_To_Library_Projs (Proj1.Project);
5545 Proj1 := Proj1.Next;
5548 -- Check if importing libraries should be regenerated
5549 -- because at least an imported library will be
5550 -- regenerated or is more recent.
5552 Proj1 := Project_Tree.Projects;
5553 while Proj1 /= null loop
5554 if Proj1.Project.Library
5555 and then Proj1.Project.Library_Kind /= Static
5556 and then not Proj1.Project.Need_To_Build_Lib
5557 and then not Proj1.Project.Externally_Built
5560 List : Project_List;
5562 Rebuild : Boolean := False;
5564 Lib_Timestamp1 : constant Time_Stamp_Type :=
5565 Proj1.Project.Library_TS;
5568 List := Proj1.Project.All_Imported_Projects;
5569 while List /= null loop
5570 Proj2 := List.Project;
5572 if Proj2.Library then
5573 if Proj2.Need_To_Build_Lib
5575 (Lib_Timestamp1 < Proj2.Library_TS)
5586 Proj1.Project.Need_To_Build_Lib := True;
5587 Add_To_Library_Projs (Proj1.Project);
5592 Proj1 := Proj1.Next;
5595 -- Reset the flags Need_To_Build_Lib for the next main,
5596 -- to avoid rebuilding libraries uselessly.
5598 Proj1 := Project_Tree.Projects;
5599 while Proj1 /= null loop
5600 Proj1.Project.Need_To_Build_Lib := False;
5601 Proj1 := Proj1.Next;
5605 -- Build the libraries, if any need to be built
5607 for J in 1 .. Library_Projs.Last loop
5608 Library_Rebuilt := True;
5610 -- If a library is rebuilt, then executables are obsolete
5612 Executable_Obsolete := True;
5614 MLib.Prj.Build_Library
5615 (For_Project => Library_Projs.Table (J),
5616 In_Tree => Project_Tree,
5617 Gnatbind => Gnatbind.all,
5618 Gnatbind_Path => Gnatbind_Path,
5620 Gcc_Path => Gcc_Path);
5624 if List_Dependencies then
5625 if First_Compiled_File /= No_File then
5627 (First_Compiled_File,
5628 "must be recompiled. Can't generate dependence list.");
5633 elsif First_Compiled_File = No_File
5634 and then not Do_Bind_Step
5635 and then not Quiet_Output
5636 and then not Library_Rebuilt
5637 and then Osint.Number_Of_Files = 1
5639 Inform (Msg => "objects up to date.");
5641 elsif Do_Not_Execute
5642 and then First_Compiled_File /= No_File
5644 Write_Name (First_Compiled_File);
5648 -- Stop after compile step if any of:
5650 -- 1) -n (Do_Not_Execute) specified
5652 -- 2) -M (List_Dependencies) specified (also sets
5653 -- Do_Not_Execute above, so this is probably superfluous).
5655 -- 3) -c (Compile_Only) specified, but not -b (Bind_Only)
5657 -- 4) Made unit cannot be a main unit
5660 or List_Dependencies
5662 or not Is_Main_Unit)
5663 and then not No_Main_Subprogram
5664 and then not Build_Bind_And_Link_Full_Project)
5665 or else Unique_Compile
5667 if Osint.Number_Of_Files = 1 then
5668 exit Multiple_Main_Loop;
5675 -- If the objects were up-to-date check if the executable file
5676 -- is also up-to-date. For now always bind and link on the JVM
5677 -- since there is currently no simple way to check whether
5678 -- objects are up-to-date.
5680 if Targparm.VM_Target /= JVM_Target
5681 and then First_Compiled_File = No_File
5683 Executable_Stamp := File_Stamp (Executable);
5685 if not Executable_Obsolete then
5686 Executable_Obsolete :=
5687 Youngest_Obj_Stamp > Executable_Stamp;
5690 if not Executable_Obsolete then
5691 for Index in reverse 1 .. Dependencies.Last loop
5693 (Dependencies.Table (Index).Depends_On)
5695 Enter_Into_Obsoleted
5696 (Dependencies.Table (Index).This);
5700 Executable_Obsolete := Is_In_Obsoleted (Main_Source_File);
5704 if not Executable_Obsolete then
5706 -- If no Ada object files obsolete the executable, check
5707 -- for younger or missing linker files.
5709 Check_Linker_Options
5712 Youngest_Obj_Stamp);
5714 Executable_Obsolete := Youngest_Obj_File /= No_File;
5717 -- Check if any library file is more recent than the
5718 -- executable: there may be an externally built library
5719 -- file that has been modified.
5721 if not Executable_Obsolete
5722 and then Main_Project /= No_Project
5725 Proj1 : Project_List;
5728 Proj1 := Project_Tree.Projects;
5729 while Proj1 /= null loop
5730 if Proj1.Project.Library
5732 Proj1.Project.Library_TS > Executable_Stamp
5734 Executable_Obsolete := True;
5735 Youngest_Obj_Stamp := Proj1.Project.Library_TS;
5737 Add_Str_To_Name_Buffer ("library ");
5738 Add_Str_To_Name_Buffer
5739 (Get_Name_String (Proj1.Project.Library_Name));
5740 Youngest_Obj_File := Name_Find;
5744 Proj1 := Proj1.Next;
5749 -- Return if the executable is up to date and otherwise
5750 -- motivate the relink/rebind.
5752 if not Executable_Obsolete then
5753 if not Quiet_Output then
5754 Inform (Executable, "up to date.");
5757 if Osint.Number_Of_Files = 1 then
5758 exit Multiple_Main_Loop;
5765 if Executable_Stamp (1) = ' ' then
5766 if not No_Main_Subprogram then
5767 Verbose_Msg (Executable, "missing.", Prefix => " ");
5770 elsif Youngest_Obj_Stamp (1) = ' ' then
5772 (Youngest_Obj_File, "missing.", Prefix => " ");
5774 elsif Youngest_Obj_Stamp > Executable_Stamp then
5777 "(" & String (Youngest_Obj_Stamp) & ") newer than",
5779 "(" & String (Executable_Stamp) & ")");
5783 (Executable, "needs to be rebuilt", Prefix => " ");
5787 end Recursive_Compilation_Step;
5790 -- For binding and linking, we need to be in the object directory of
5791 -- the main project.
5793 if Main_Project /= No_Project then
5794 Change_To_Object_Directory (Main_Project);
5797 -- If we are here, it means that we need to rebuilt the current main,
5798 -- so we set Executable_Obsolete to True to make sure that subsequent
5799 -- mains will be rebuilt.
5801 Main_ALI_In_Place_Mode_Step : declare
5802 ALI_File : File_Name_Type;
5803 Src_File : File_Name_Type;
5806 Src_File := Strip_Directory (Main_Source_File);
5807 ALI_File := Lib_File_Name (Src_File, Current_Main_Index);
5808 Main_ALI_File := Full_Lib_File_Name (ALI_File);
5810 -- When In_Place_Mode, the library file can be located in the
5811 -- Main_Source_File directory which may not be present in the
5812 -- library path. If it is not present then use the corresponding
5813 -- library file name.
5815 if Main_ALI_File = No_File and then In_Place_Mode then
5816 Get_Name_String (Get_Directory (Full_Source_Name (Src_File)));
5817 Get_Name_String_And_Append (ALI_File);
5818 Main_ALI_File := Name_Find;
5819 Main_ALI_File := Full_Lib_File_Name (Main_ALI_File);
5822 if Main_ALI_File = No_File then
5823 Make_Failed ("could not find the main ALI file");
5825 end Main_ALI_In_Place_Mode_Step;
5827 if Do_Bind_Step then
5829 Args : Argument_List
5830 (Binder_Switches.First .. Binder_Switches.Last + 2);
5831 -- The arguments for the invocation of gnatbind
5833 Last_Arg : Natural := Binder_Switches.Last;
5834 -- Index of the last argument in Args
5836 Shared_Libs : Boolean := False;
5837 -- Set to True when there are shared library project files or
5838 -- when gnatbind is invoked with -shared.
5840 Proj : Project_List;
5843 -- Check if there are shared libraries, so that gnatbind is
5844 -- called with -shared. Check also if gnatbind is called with
5845 -- -shared, so that gnatlink is called with -shared-libgcc
5846 -- ensuring that the shared version of libgcc will be used.
5848 if Main_Project /= No_Project
5849 and then MLib.Tgt.Support_For_Libraries /= Prj.None
5851 Proj := Project_Tree.Projects;
5852 while Proj /= null loop
5853 if Proj.Project.Library
5854 and then Proj.Project.Library_Kind /= Static
5856 Shared_Libs := True;
5857 Bind_Shared := Shared_Switch'Access;
5864 -- Check now for switch -shared
5866 if not Shared_Libs then
5867 for J in Binder_Switches.First .. Last_Arg loop
5868 if Binder_Switches.Table (J).all = "-shared" then
5869 Shared_Libs := True;
5875 -- If shared libraries present, invoke gnatlink with
5879 Link_With_Shared_Libgcc := Shared_Libgcc_Switch'Access;
5882 -- Get all the binder switches
5884 for J in Binder_Switches.First .. Last_Arg loop
5885 Args (J) := Binder_Switches.Table (J);
5888 if Stand_Alone_Libraries then
5889 Last_Arg := Last_Arg + 1;
5890 Args (Last_Arg) := Force_Elab_Flags_String'Access;
5893 if Main_Project /= No_Project then
5895 -- Put all the source directories in ADA_INCLUDE_PATH,
5896 -- and all the object directories in ADA_OBJECTS_PATH,
5897 -- except those of library projects.
5899 Prj.Env.Set_Ada_Paths
5900 (Main_Project, Project_Tree, Use_Include_Path_File);
5902 -- If switch -C was specified, create a binder mapping file
5904 if Create_Mapping_File then
5905 Mapping_Path := Create_Binder_Mapping_File (Project_Tree);
5907 if Mapping_Path /= No_Path then
5908 Last_Arg := Last_Arg + 1;
5910 new String'("-F=" & Get_Name_String (Mapping_Path));
5917 Bind (Main_ALI_File,
5918 Bind_Shared.all & Args (Args'First .. Last_Arg));
5923 -- Delete the temporary mapping file if one was created
5925 if Mapping_Path /= No_Path then
5926 Delete_Temporary_File
5927 (Project_Tree.Shared, Mapping_Path);
5930 -- And reraise the exception
5935 -- If -dn was not specified, delete the temporary mapping file
5936 -- if one was created.
5938 if Mapping_Path /= No_Path then
5939 Delete_Temporary_File (Project_Tree.Shared, Mapping_Path);
5944 if Do_Link_Step then
5946 Linker_Switches_Last : constant Integer := Linker_Switches.Last;
5947 Path_Option : constant String_Access :=
5948 MLib.Linker_Library_Path_Option;
5949 Libraries_Present : Boolean := False;
5953 Proj1 : Project_List;
5956 if not Run_Path_Option then
5957 Linker_Switches.Increment_Last;
5958 Linker_Switches.Table (Linker_Switches.Last) :=
5962 if Main_Project /= No_Project then
5963 Library_Paths.Set_Last (0);
5966 if MLib.Tgt.Support_For_Libraries /= Prj.None then
5968 -- Check for library projects
5970 Proj1 := Project_Tree.Projects;
5971 while Proj1 /= null loop
5972 if Proj1.Project /= Main_Project
5973 and then Proj1.Project.Library
5975 -- Add this project to table Library_Projs
5977 Libraries_Present := True;
5978 Depth := Proj1.Project.Depth;
5979 Library_Projs.Increment_Last;
5980 Current := Library_Projs.Last;
5982 -- Any project with a greater depth should be
5983 -- after this project in the list.
5985 while Current > 1 loop
5986 Proj2 := Library_Projs.Table (Current - 1);
5987 exit when Proj2.Depth <= Depth;
5988 Library_Projs.Table (Current) := Proj2;
5989 Current := Current - 1;
5992 Library_Projs.Table (Current) := Proj1.Project;
5994 -- If it is not a static library and path option
5995 -- is set, add it to the Library_Paths table.
5997 if Proj1.Project.Library_Kind /= Static
5998 and then Path_Option /= null
6000 Library_Paths.Increment_Last;
6001 Library_Paths.Table (Library_Paths.Last) :=
6004 (Proj1.Project.Library_Dir.Display_Name));
6008 Proj1 := Proj1.Next;
6011 for Index in 1 .. Library_Projs.Last loop
6012 if Library_Projs.Table (Index).Library_Kind = Static
6013 and then not Targparm.OpenVMS_On_Target
6015 Linker_Switches.Increment_Last;
6016 Linker_Switches.Table (Linker_Switches.Last) :=
6019 (Library_Projs.Table
6020 (Index).Library_Dir.Display_Name) &
6023 (Library_Projs.Table (Index). Library_Name) &
6025 MLib.Tgt.Archive_Ext);
6028 -- Add the -L switch
6030 Linker_Switches.Increment_Last;
6031 Linker_Switches.Table (Linker_Switches.Last) :=
6034 (Library_Projs.Table (Index).
6035 Library_Dir.Display_Name));
6037 -- Add the -l switch
6039 Linker_Switches.Increment_Last;
6040 Linker_Switches.Table (Linker_Switches.Last) :=
6043 (Library_Projs.Table (Index).
6049 if Libraries_Present then
6051 -- If Path_Option is not null, create the switch
6052 -- ("-Wl,-rpath," or equivalent) with all the non-static
6053 -- library dirs plus the standard GNAT library dir.
6054 -- We do that only if Run_Path_Option is True
6055 -- (not disabled by -R switch).
6057 if Run_Path_Option and then Path_Option /= null then
6059 Option : String_Access;
6060 Length : Natural := Path_Option'Length;
6064 if MLib.Separate_Run_Path_Options then
6066 -- We are going to create one switch of the form
6067 -- "-Wl,-rpath,dir_N" for each directory to
6070 -- One switch for each library directory
6073 Library_Paths.First .. Library_Paths.Last
6075 Linker_Switches.Increment_Last;
6076 Linker_Switches.Table
6077 (Linker_Switches.Last) :=
6080 Library_Paths.Table (Index).all);
6083 -- One switch for the standard GNAT library dir
6085 Linker_Switches.Increment_Last;
6086 Linker_Switches.Table
6087 (Linker_Switches.Last) :=
6089 (Path_Option.all & MLib.Utl.Lib_Directory);
6092 -- We are going to create one switch of the form
6093 -- "-Wl,-rpath,dir_1:dir_2:dir_3"
6096 Library_Paths.First .. Library_Paths.Last
6098 -- Add the length of the library dir plus one
6099 -- for the directory separator.
6103 Library_Paths.Table (Index)'Length + 1;
6106 -- Finally, add the length of the standard GNAT
6109 Length := Length + MLib.Utl.Lib_Directory'Length;
6110 Option := new String (1 .. Length);
6111 Option (1 .. Path_Option'Length) :=
6113 Current := Path_Option'Length;
6115 -- Put each library dir followed by a dir
6119 Library_Paths.First .. Library_Paths.Last
6124 Library_Paths.Table (Index)'Length) :=
6125 Library_Paths.Table (Index).all;
6128 Library_Paths.Table (Index)'Length + 1;
6129 Option (Current) := Path_Separator;
6132 -- Finally put the standard GNAT library dir
6136 Current + MLib.Utl.Lib_Directory'Length) :=
6137 MLib.Utl.Lib_Directory;
6139 -- And add the switch to the linker switches
6141 Linker_Switches.Increment_Last;
6142 Linker_Switches.Table (Linker_Switches.Last) :=
6150 -- Put the object directories in ADA_OBJECTS_PATH
6152 Prj.Env.Set_Ada_Paths
6155 Including_Libraries => False,
6156 Include_Path => False);
6158 -- Check for attributes Linker'Linker_Options in projects
6159 -- other than the main project
6162 Linker_Options : constant String_List :=
6163 Linker_Options_Switches
6165 Do_Fail => Make_Failed'Access,
6166 In_Tree => Project_Tree);
6168 for Option in Linker_Options'Range loop
6169 Linker_Switches.Increment_Last;
6170 Linker_Switches.Table (Linker_Switches.Last) :=
6171 Linker_Options (Option);
6176 -- Add switch -M to gnatlink if builder switch
6177 -- --create-map-file has been specified.
6179 if Map_File /= null then
6180 Linker_Switches.Increment_Last;
6181 Linker_Switches.Table (Linker_Switches.Last) :=
6182 new String'("-M" & Map_File.all);
6186 Args : Argument_List
6187 (Linker_Switches.First .. Linker_Switches.Last + 2);
6189 Last_Arg : Integer := Linker_Switches.First - 1;
6190 Skip : Boolean := False;
6193 -- Get all the linker switches
6195 for J in Linker_Switches.First .. Linker_Switches.Last loop
6199 elsif Non_Std_Executable
6200 and then Linker_Switches.Table (J).all = "-o"
6204 -- Here we capture and duplicate the linker argument. We
6205 -- need to do the duplication since the arguments will
6206 -- get normalized. Not doing so will result in calling
6207 -- normalized two times for the same set of arguments if
6208 -- gnatmake is passed multiple mains. This can result in
6209 -- the wrong argument being passed to the linker.
6212 Last_Arg := Last_Arg + 1;
6214 new String'(Linker_Switches.Table (J).all);
6218 -- If need be, add the -o switch
6220 if Non_Std_Executable then
6221 Last_Arg := Last_Arg + 1;
6222 Args (Last_Arg) := new String'("-o");
6223 Last_Arg := Last_Arg + 1;
6225 new String'(Get_Name_String (Executable));
6228 -- And invoke the linker
6231 Success : Boolean := False;
6233 Link (Main_ALI_File,
6234 Link_With_Shared_Libgcc.all &
6235 Args (Args'First .. Last_Arg),
6239 Successful_Links.Increment_Last;
6240 Successful_Links.Table (Successful_Links.Last) :=
6243 elsif Osint.Number_Of_Files = 1
6244 or else not Keep_Going
6246 Make_Failed ("*** link failed.");
6250 Write_Line ("*** link failed");
6252 if Commands_To_Stdout then
6253 Set_Standard_Output;
6256 Failed_Links.Increment_Last;
6257 Failed_Links.Table (Failed_Links.Last) :=
6263 Linker_Switches.Set_Last (Linker_Switches_Last);
6267 -- We go to here when we skip the bind and link steps
6271 -- We go to the next main, if we did not process the last one
6273 if N_File < Osint.Number_Of_Files then
6274 Main_Source_File := Next_Main_Source;
6276 if Current_File_Index /= No_Index then
6277 Main_Index := Current_File_Index;
6280 if Main_Project /= No_Project then
6282 -- Find the file name of the main unit
6285 Main_Source_File_Name : constant String :=
6286 Get_Name_String (Main_Source_File);
6288 Main_Unit_File_Name : constant String :=
6290 File_Name_Of_Library_Unit_Body
6291 (Name => Main_Source_File_Name,
6292 Project => Main_Project,
6293 In_Tree => Project_Tree,
6294 Main_Project_Only =>
6295 not Unique_Compile);
6297 The_Packages : constant Package_Id :=
6298 Main_Project.Decl.Packages;
6300 Binder_Package : constant Prj.Package_Id :=
6302 (Name => Name_Binder,
6303 In_Packages => The_Packages,
6304 Shared => Project_Tree.Shared);
6306 Linker_Package : constant Prj.Package_Id :=
6308 (Name => Name_Linker,
6309 In_Packages => The_Packages,
6310 Shared => Project_Tree.Shared);
6313 -- We fail if we cannot find the main source file
6314 -- as an immediate source of the main project file.
6316 if Main_Unit_File_Name = "" then
6317 Make_Failed ('"' & Main_Source_File_Name
6318 & """ is not a unit of project "
6319 & Project_File_Name.all & ".");
6322 -- Remove any directory information from the main
6323 -- source file name.
6326 Pos : Natural := Main_Unit_File_Name'Last;
6330 exit when Pos < Main_Unit_File_Name'First
6332 Main_Unit_File_Name (Pos) = Directory_Separator;
6336 Name_Len := Main_Unit_File_Name'Last - Pos;
6338 Name_Buffer (1 .. Name_Len) :=
6340 (Pos + 1 .. Main_Unit_File_Name'Last);
6342 Main_Source_File := Name_Find;
6346 -- We now deal with the binder and linker switches.
6347 -- If no project file is used, there is nothing to do
6348 -- because the binder and linker switches are the same
6351 -- Reset the tables Binder_Switches and Linker_Switches
6353 Binder_Switches.Set_Last (Last_Binder_Switch);
6354 Linker_Switches.Set_Last (Last_Linker_Switch);
6356 -- Add binder switches from the project file for this main,
6359 if Do_Bind_Step and then Binder_Package /= No_Package then
6360 if Verbose_Mode then
6361 Write_Str ("Adding binder switches for """);
6362 Write_Str (Main_Unit_File_Name);
6367 (Project_Node_Tree => Project_Node_Tree,
6368 Env => Root_Environment,
6369 File_Name => Main_Unit_File_Name,
6370 Index => Main_Index,
6371 The_Package => Binder_Package,
6375 -- Add linker switches from the project file for this main,
6378 if Do_Link_Step and then Linker_Package /= No_Package then
6379 if Verbose_Mode then
6380 Write_Str ("Adding linker switches for""");
6381 Write_Str (Main_Unit_File_Name);
6386 (Project_Node_Tree => Project_Node_Tree,
6387 Env => Root_Environment,
6388 File_Name => Main_Unit_File_Name,
6389 Index => Main_Index,
6390 The_Package => Linker_Package,
6394 -- As we are using a project file, for relative paths we add
6395 -- the current working directory for any relative path on
6396 -- the command line and the project directory, for any
6397 -- relative path in the project file.
6400 Dir_Path : constant String :=
6402 (Main_Project.Directory.Display_Name);
6406 J in Last_Binder_Switch + 1 .. Binder_Switches.Last
6408 Test_If_Relative_Path
6409 (Binder_Switches.Table (J),
6410 Do_Fail => Make_Failed'Access,
6411 Parent => Dir_Path, Including_L_Switch => False);
6415 J in Last_Linker_Switch + 1 .. Linker_Switches.Last
6417 Test_If_Relative_Path
6418 (Linker_Switches.Table (J), Parent => Dir_Path,
6419 Do_Fail => Make_Failed'Access);
6423 -- We now put in the Binder_Switches and Linker_Switches
6424 -- tables, the binder and linker switches of the command
6425 -- line that have been put in the Saved_ tables.
6426 -- These switches will follow the project file switches.
6428 for J in 1 .. Saved_Binder_Switches.Last loop
6430 (Saved_Binder_Switches.Table (J),
6435 for J in 1 .. Saved_Linker_Switches.Last loop
6437 (Saved_Linker_Switches.Table (J),
6446 end loop Multiple_Main_Loop;
6448 if Do_Codepeer_Globalize_Step then
6450 Success : Boolean := False;
6452 Globalize (Success);
6456 Write_Str ("*** globalize failed.");
6458 if Commands_To_Stdout then
6459 Set_Standard_Output;
6465 if Failed_Links.Last > 0 then
6466 for Index in 1 .. Successful_Links.Last loop
6467 Write_Str ("Linking of """);
6468 Write_Str (Get_Name_String (Successful_Links.Table (Index)));
6469 Write_Line (""" succeeded.");
6474 for Index in 1 .. Failed_Links.Last loop
6475 Write_Str ("Linking of """);
6476 Write_Str (Get_Name_String (Failed_Links.Table (Index)));
6477 Write_Line (""" failed.");
6480 if Commands_To_Stdout then
6481 Set_Standard_Output;
6484 if Total_Compilation_Failures = 0 then
6485 Report_Compilation_Failed;
6489 if Total_Compilation_Failures /= 0 then
6490 List_Bad_Compilations;
6491 Report_Compilation_Failed;
6494 -- Delete the temporary mapping file that was created if we are
6495 -- using project files.
6497 Delete_All_Temp_Files;
6499 -- Output Namet statistics
6506 Write_Line (Exception_Information (X));
6507 Make_Failed ("INTERNAL ERROR. Please report.");
6514 function Hash (F : File_Name_Type) return Header_Num is
6516 return Header_Num (1 + F mod Max_Header);
6519 --------------------
6520 -- In_Ada_Lib_Dir --
6521 --------------------
6523 function In_Ada_Lib_Dir (File : File_Name_Type) return Boolean is
6524 D : constant File_Name_Type := Get_Directory (File);
6525 B : constant Byte := Get_Name_Table_Byte (D);
6527 return (B and Ada_Lib_Dir) /= 0;
6530 -----------------------
6531 -- Init_Mapping_File --
6532 -----------------------
6534 procedure Init_Mapping_File
6535 (Project : Project_Id;
6536 Data : in out Project_Compilation_Data;
6537 File_Index : in out Natural)
6539 FD : File_Descriptor;
6541 -- For call to Close
6544 -- Increase the index of the last mapping file for this project
6546 Data.Last_Mapping_File_Names := Data.Last_Mapping_File_Names + 1;
6548 -- If there is a project file, call Create_Mapping_File with
6551 if Project /= No_Project then
6552 Prj.Env.Create_Mapping_File
6554 In_Tree => Project_Tree,
6555 Language => Name_Ada,
6556 Name => Data.Mapping_File_Names
6557 (Data.Last_Mapping_File_Names));
6559 -- Otherwise, just create an empty file
6562 Tempdir.Create_Temp_File
6564 Data.Mapping_File_Names (Data.Last_Mapping_File_Names));
6566 if FD = Invalid_FD then
6567 Make_Failed ("disk full");
6571 (Project_Tree.Shared,
6572 Data.Mapping_File_Names (Data.Last_Mapping_File_Names));
6578 Make_Failed ("disk full");
6582 -- And return the index of the newly created file
6584 File_Index := Data.Last_Mapping_File_Names;
6585 end Init_Mapping_File;
6591 procedure Initialize
6592 (Project_Node_Tree : out Project_Node_Tree_Ref;
6593 Env : out Prj.Tree.Environment)
6595 procedure Check_Version_And_Help is
6596 new Check_Version_And_Help_G (Makeusg);
6598 -- Start of processing for Initialize
6601 -- Prepare the project's tree, since this is used to hold external
6602 -- references, project path and other attributes that can be impacted by
6603 -- the command line switches
6605 Prj.Tree.Initialize (Env, Gnatmake_Flags);
6606 Prj.Env.Initialize_Default_Project_Path
6607 (Env.Project_Path, Target_Name => "");
6609 Project_Node_Tree := new Project_Node_Tree_Data;
6610 Prj.Tree.Initialize (Project_Node_Tree);
6612 -- Override default initialization of Check_Object_Consistency since
6613 -- this is normally False for GNATBIND, but is True for GNATMAKE since
6614 -- we do not need to check source consistency again once GNATMAKE has
6615 -- looked at the sources to check.
6617 Check_Object_Consistency := True;
6619 -- Package initializations (the order of calls is important here)
6621 Output.Set_Standard_Error;
6624 Binder_Switches.Init;
6625 Linker_Switches.Init;
6630 Prj.Initialize (Project_Tree);
6634 RTS_Specified := null;
6639 -- Add the directory where gnatmake is invoked in front of the path,
6640 -- if gnatmake is invoked from a bin directory or with directory
6641 -- information. Only do this if the platform is not VMS, where the
6642 -- notion of path does not really exist.
6646 Prefix : constant String := Executable_Prefix_Path;
6647 Command : constant String := Command_Name;
6650 if Prefix'Length > 0 then
6652 PATH : constant String :=
6653 Prefix & Directory_Separator & "bin" &
6655 Getenv ("PATH").all;
6657 Setenv ("PATH", PATH);
6661 for Index in reverse Command'Range loop
6662 if Command (Index) = Directory_Separator then
6664 Absolute_Dir : constant String :=
6666 (Command (Command'First .. Index));
6667 PATH : constant String :=
6670 Getenv ("PATH").all;
6672 Setenv ("PATH", PATH);
6682 -- Scan the switches and arguments
6684 -- First, scan to detect --version and/or --help
6686 Check_Version_And_Help ("GNATMAKE", "1995");
6688 -- Scan again the switch and arguments, now that we are sure that they
6689 -- do not include --version or --help.
6691 Scan_Args : for Next_Arg in 1 .. Argument_Count loop
6692 Scan_Make_Arg (Env, Argument (Next_Arg), And_Save => True);
6695 if N_M_Switch > 0 and RTS_Specified = null then
6696 Process_Multilib (Env);
6699 if Commands_To_Stdout then
6700 Set_Standard_Output;
6703 if Usage_Requested then
6707 -- Test for trailing -P switch
6709 if Project_File_Name_Present and then Project_File_Name = null then
6710 Make_Failed ("project file name missing after -P");
6712 -- Test for trailing -o switch
6714 elsif Output_File_Name_Present
6715 and then not Output_File_Name_Seen
6717 Make_Failed ("output file name missing after -o");
6719 -- Test for trailing -D switch
6721 elsif Object_Directory_Present
6722 and then not Object_Directory_Seen then
6723 Make_Failed ("object directory missing after -D");
6726 -- Test for simultaneity of -i and -D
6728 if Object_Directory_Path /= null and then In_Place_Mode then
6729 Make_Failed ("-i and -D cannot be used simultaneously");
6732 -- Deal with -C= switch
6734 if Gnatmake_Mapping_File /= null then
6736 -- First, check compatibility with other switches
6738 if Project_File_Name /= null then
6739 Make_Failed ("-C= switch is not compatible with -P switch");
6741 elsif Saved_Maximum_Processes > 1 then
6742 Make_Failed ("-C= switch is not compatible with -jnnn switch");
6745 Fmap.Initialize (Gnatmake_Mapping_File.all);
6747 ("-gnatem=" & Gnatmake_Mapping_File.all,
6752 if Project_File_Name /= null then
6754 -- A project file was specified by a -P switch
6756 if Verbose_Mode then
6758 Write_Str ("Parsing project file """);
6759 Write_Str (Project_File_Name.all);
6764 -- Avoid looking in the current directory for ALI files
6766 -- Look_In_Primary_Dir := False;
6768 -- Set the project parsing verbosity to whatever was specified
6769 -- by a possible -vP switch.
6771 Prj.Pars.Set_Verbosity (To => Current_Verbosity);
6773 -- Parse the project file.
6774 -- If there is an error, Main_Project will still be No_Project.
6777 (Project => Main_Project,
6778 In_Tree => Project_Tree,
6779 Project_File_Name => Project_File_Name.all,
6780 Packages_To_Check => Packages_To_Check_By_Gnatmake,
6782 In_Node_Tree => Project_Node_Tree);
6784 -- The parsing of project files may have changed the current output
6786 if Commands_To_Stdout then
6787 Set_Standard_Output;
6792 if Main_Project = No_Project then
6794 ("""" & Project_File_Name.all & """ processing failed");
6797 Create_Mapping_File := True;
6799 if Verbose_Mode then
6801 Write_Str ("Parsing of project file """);
6802 Write_Str (Project_File_Name.all);
6803 Write_Str (""" is finished.");
6807 -- We add the source directories and the object directories to the
6809 -- ??? Why do we need these search directories, we already know the
6810 -- locations from parsing the project, except for the runtime which
6811 -- has its own directories anyway
6813 Add_Source_Directories (Main_Project, Project_Tree);
6814 Add_Object_Directories (Main_Project, Project_Tree);
6816 Recursive_Compute_Depth (Main_Project);
6817 Compute_All_Imported_Projects (Project_Tree);
6821 Osint.Add_Default_Search_Dirs;
6823 -- Source file lookups should be cached for efficiency. Source files
6824 -- are not supposed to change. However, we do that now only if no
6825 -- project file is used; if a project file is used, we do it just
6826 -- after changing the directory to the object directory.
6828 Osint.Source_File_Data (Cache => True);
6830 -- Read gnat.adc file to initialize Fname.UF
6832 Fname.UF.Initialize;
6835 Fname.SF.Read_Source_File_Name_Pragmas;
6838 when Err : SFN_Scan.Syntax_Error_In_GNAT_ADC =>
6839 Make_Failed (Exception_Message (Err));
6843 -- Make sure no project object directory is recorded
6845 Project_Of_Current_Object_Directory := No_Project;
6849 ----------------------------
6850 -- Insert_Project_Sources --
6851 ----------------------------
6853 procedure Insert_Project_Sources
6854 (The_Project : Project_Id;
6855 All_Projects : Boolean;
6858 Put_In_Q : Boolean := Into_Q;
6860 Sfile : File_Name_Type;
6862 Project : Project_Id;
6864 Extending : constant Boolean := The_Project.Extends /= No_Project;
6866 function Check_Project (P : Project_Id) return Boolean;
6867 -- Returns True if P is The_Project or a project extended by The_Project
6873 function Check_Project (P : Project_Id) return Boolean is
6875 if All_Projects or else P = The_Project then
6878 elsif Extending then
6883 Proj := The_Project;
6884 while Proj /= null loop
6885 if P = Proj.Extends then
6889 Proj := Proj.Extends;
6897 -- Start of processing for Insert_Project_Sources
6900 -- For all the sources in the project files,
6902 Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
6903 while Unit /= null loop
6906 Project := No_Project;
6908 -- If there is a source for the body, and the body has not been
6911 if Unit.File_Names (Impl) /= null
6912 and then not Unit.File_Names (Impl).Locally_Removed
6914 -- And it is a source for the specified project
6916 if Check_Project (Unit.File_Names (Impl).Project) then
6917 Project := Unit.File_Names (Impl).Project;
6919 -- If we don't have a spec, we cannot consider the source
6920 -- if it is a subunit.
6922 if Unit.File_Names (Spec) = null then
6924 Src_Ind : Source_File_Index;
6926 -- Here we are cheating a little bit: we don't want to
6927 -- use Sinput.L, because it depends on the GNAT tree
6928 -- (Atree, Sinfo, ...). So, we pretend that it is a
6929 -- project file, and we use Sinput.P.
6931 -- Source_File_Is_Subunit is just scanning through the
6932 -- file until it finds one of the reserved words
6933 -- separate, procedure, function, generic or package.
6934 -- Fortunately, these Ada reserved words are also
6935 -- reserved for project files.
6938 Src_Ind := Sinput.P.Load_Project_File
6940 (Unit.File_Names (Impl).Path.Display_Name));
6942 -- If it is a subunit, discard it
6944 if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
6948 Sfile := Unit.File_Names (Impl).Display_File;
6949 Index := Unit.File_Names (Impl).Index;
6954 Sfile := Unit.File_Names (Impl).Display_File;
6955 Index := Unit.File_Names (Impl).Index;
6959 elsif Unit.File_Names (Spec) /= null
6960 and then not Unit.File_Names (Spec).Locally_Removed
6961 and then Check_Project (Unit.File_Names (Spec).Project)
6963 -- If there is no source for the body, but there is one for the
6964 -- spec which has not been locally removed, then we take this one.
6966 Sfile := Unit.File_Names (Spec).Display_File;
6967 Index := Unit.File_Names (Spec).Index;
6968 Project := Unit.File_Names (Spec).Project;
6971 -- For the first source inserted into the Q, we need to initialize
6972 -- the Q, but not for the subsequent sources.
6975 (Main_Project /= No_Project and then
6976 One_Compilation_Per_Obj_Dir);
6978 if Sfile /= No_File then
6980 ((Format => Format_Gnatmake,
6983 Unit => No_Unit_Name,
6987 if not Put_In_Q and then Sfile /= No_File then
6989 -- If Put_In_Q is False, we add the source as if it were specified
6990 -- on the command line, and we set Put_In_Q to True, so that the
6991 -- following sources will only be put in the queue. The source is
6992 -- already in the Q, but we need at least one fake main to call
6995 if Verbose_Mode then
6996 Write_Str ("Adding """);
6997 Write_Str (Get_Name_String (Sfile));
6998 Write_Line (""" as if on the command line");
7001 Osint.Add_File (Get_Name_String (Sfile), Index);
7005 Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
7007 end Insert_Project_Sources;
7009 ---------------------
7010 -- Is_In_Obsoleted --
7011 ---------------------
7013 function Is_In_Obsoleted (F : File_Name_Type) return Boolean is
7020 Name : constant String := Get_Name_String (F);
7022 F2 : File_Name_Type;
7026 while First > Name'First
7027 and then Name (First - 1) /= Directory_Separator
7028 and then Name (First - 1) /= '/'
7033 if First /= Name'First then
7035 Add_Str_To_Name_Buffer (Name (First .. Name'Last));
7042 return Obsoleted.Get (F2);
7045 end Is_In_Obsoleted;
7047 ----------------------------
7048 -- Is_In_Object_Directory --
7049 ----------------------------
7051 function Is_In_Object_Directory
7052 (Source_File : File_Name_Type;
7053 Full_Lib_File : File_Name_Type) return Boolean
7056 -- There is something to check only when using project files. Otherwise,
7057 -- this function returns True (last line of the function).
7059 if Main_Project /= No_Project then
7061 Source_File_Name : constant String :=
7062 Get_Name_String (Source_File);
7063 Saved_Verbosity : constant Verbosity := Current_Verbosity;
7064 Project : Project_Id := No_Project;
7066 Path_Name : Path_Name_Type := No_Path;
7067 pragma Warnings (Off, Path_Name);
7070 -- Call Get_Reference to know the ultimate extending project of
7071 -- the source. Call it with verbosity default to avoid verbose
7074 Current_Verbosity := Default;
7075 Prj.Env.Get_Reference
7076 (Source_File_Name => Source_File_Name,
7078 In_Tree => Project_Tree,
7080 Current_Verbosity := Saved_Verbosity;
7082 -- If this source is in a project, check that the ALI file is in
7083 -- its object directory. If it is not, return False, so that the
7084 -- ALI file will not be skipped.
7086 if Project /= No_Project then
7088 Object_Directory : constant String :=
7092 Object_Directory.Display_Name));
7094 Olast : Natural := Object_Directory'Last;
7096 Lib_File_Directory : constant String :=
7097 Normalize_Pathname (Dir_Name
7098 (Get_Name_String (Full_Lib_File)));
7100 Llast : Natural := Lib_File_Directory'Last;
7103 -- For directories, Normalize_Pathname may or may not put
7104 -- a directory separator at the end, depending on its input.
7105 -- Remove any last directory separator before comparison.
7106 -- Returns True only if the two directories are the same.
7108 if Object_Directory (Olast) = Directory_Separator then
7112 if Lib_File_Directory (Llast) = Directory_Separator then
7116 return Object_Directory (Object_Directory'First .. Olast) =
7117 Lib_File_Directory (Lib_File_Directory'First .. Llast);
7123 -- When the source is not in a project file, always return True
7126 end Is_In_Object_Directory;
7133 (ALI_File : File_Name_Type;
7134 Args : Argument_List;
7135 Success : out Boolean)
7137 Link_Args : Argument_List (1 .. Args'Length + 1);
7140 Get_Name_String (ALI_File);
7141 Link_Args (1) := new String'(Name_Buffer (1 .. Name_Len));
7143 Link_Args (2 .. Args'Length + 1) := Args;
7145 GNAT.OS_Lib.Normalize_Arguments (Link_Args);
7147 Display (Gnatlink.all, Link_Args);
7149 if Gnatlink_Path = null then
7150 Make_Failed ("error, unable to locate " & Gnatlink.all);
7153 GNAT.OS_Lib.Spawn (Gnatlink_Path.all, Link_Args, Success);
7156 ---------------------------
7157 -- List_Bad_Compilations --
7158 ---------------------------
7160 procedure List_Bad_Compilations is
7162 for J in Bad_Compilation.First .. Bad_Compilation.Last loop
7163 if Bad_Compilation.Table (J).File = No_File then
7165 elsif not Bad_Compilation.Table (J).Found then
7166 Inform (Bad_Compilation.Table (J).File, "not found");
7168 Inform (Bad_Compilation.Table (J).File, "compilation error");
7171 end List_Bad_Compilations;
7177 procedure List_Depend is
7178 Lib_Name : File_Name_Type;
7179 Obj_Name : File_Name_Type;
7180 Src_Name : File_Name_Type;
7184 Line_Size : constant := 77;
7187 Set_Standard_Output;
7189 for A in ALIs.First .. ALIs.Last loop
7190 Lib_Name := ALIs.Table (A).Afile;
7192 -- We have to provide the full library file name in In_Place_Mode
7194 if In_Place_Mode then
7195 Lib_Name := Full_Lib_File_Name (Lib_Name);
7198 Obj_Name := Object_File_Name (Lib_Name);
7199 Write_Name (Obj_Name);
7202 Get_Name_String (Obj_Name);
7204 Line_Pos := Len + 2;
7206 for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
7207 Src_Name := Sdep.Table (D).Sfile;
7209 if Is_Internal_File_Name (Src_Name)
7210 and then not Check_Readonly_Files
7214 if not Quiet_Output then
7215 Src_Name := Full_Source_Name (Src_Name);
7218 Get_Name_String (Src_Name);
7221 if Line_Pos + Len + 1 > Line_Size then
7227 Line_Pos := Line_Pos + Len + 1;
7230 Write_Name (Src_Name);
7237 if not Commands_To_Stdout then
7246 procedure Make_Failed (S : String) is
7248 Delete_All_Temp_Files;
7252 --------------------
7253 -- Mark_Directory --
7254 --------------------
7256 procedure Mark_Directory
7258 Mark : Lib_Mark_Type;
7259 On_Command_Line : Boolean)
7264 function Base_Directory return String;
7265 -- If Dir comes from the command line, empty string (relative paths are
7266 -- resolved with respect to the current directory), else return the main
7267 -- project's directory.
7269 --------------------
7270 -- Base_Directory --
7271 --------------------
7273 function Base_Directory return String is
7275 if On_Command_Line then
7278 return Get_Name_String (Main_Project.Directory.Display_Name);
7282 Real_Path : constant String := Normalize_Pathname (Dir, Base_Directory);
7284 -- Start of processing for Mark_Directory
7289 if Real_Path'Length = 0 then
7290 Add_Str_To_Name_Buffer (Dir);
7293 Add_Str_To_Name_Buffer (Real_Path);
7296 -- Last character is supposed to be a directory separator
7298 if not Is_Directory_Separator (Name_Buffer (Name_Len)) then
7299 Add_Char_To_Name_Buffer (Directory_Separator);
7302 -- Add flags to the already existing flags
7305 B := Get_Name_Table_Byte (N);
7306 Set_Name_Table_Byte (N, B or Mark);
7309 ----------------------
7310 -- Process_Multilib --
7311 ----------------------
7313 procedure Process_Multilib (Env : in out Prj.Tree.Environment) is
7314 Output_FD : File_Descriptor;
7315 Output_Name : String_Access;
7316 Arg_Index : Natural := 0;
7317 Success : Boolean := False;
7318 Return_Code : Integer := 0;
7319 Multilib_Gcc_Path : String_Access;
7320 Multilib_Gcc : String_Access;
7321 N_Read : Integer := 0;
7322 Line : String (1 .. 1000);
7323 Args : Argument_List (1 .. N_M_Switch + 1);
7326 pragma Assert (N_M_Switch > 0 and RTS_Specified = null);
7328 -- In case we detected a multilib switch and the user has not
7329 -- manually specified a specific RTS we emulate the following command:
7330 -- gnatmake $FLAGS --RTS=$(gcc -print-multi-directory $FLAGS)
7332 -- First select the flags which might have an impact on multilib
7333 -- processing. Note that this is an heuristic selection and it
7334 -- will need to be maintained over time. The condition has to
7335 -- be kept synchronized with N_M_Switch counting in Scan_Make_Arg.
7337 for Next_Arg in 1 .. Argument_Count loop
7339 Argv : constant String := Argument (Next_Arg);
7342 and then Argv (1) = '-'
7343 and then Argv (2) = 'm'
7344 and then Argv /= "-margs"
7346 -- Ignore -mieee to avoid spawning an extra gcc in this case
7348 and then Argv /= "-mieee"
7350 Arg_Index := Arg_Index + 1;
7351 Args (Arg_Index) := new String'(Argv);
7356 pragma Assert (Arg_Index = N_M_Switch);
7358 Args (Args'Last) := new String'("-print-multi-directory");
7360 -- Call the GCC driver with the collected flags and save its
7361 -- output. Alternate design would be to link in gnatmake the
7362 -- relevant part of the GCC driver.
7364 if Saved_Gcc /= null then
7365 Multilib_Gcc := Saved_Gcc;
7367 Multilib_Gcc := Gcc;
7370 Multilib_Gcc_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Multilib_Gcc.all);
7372 Create_Temp_Output_File (Output_FD, Output_Name);
7374 if Output_FD = Invalid_FD then
7379 (Multilib_Gcc_Path.all, Args, Output_FD, Return_Code, False);
7382 if Return_Code /= 0 then
7386 -- Parse the GCC driver output which is a single line, removing CR/LF
7388 Output_FD := Open_Read (Output_Name.all, Binary);
7390 if Output_FD = Invalid_FD then
7394 N_Read := Read (Output_FD, Line (1)'Address, Line'Length);
7396 Delete_File (Output_Name.all, Success);
7398 for J in reverse 1 .. N_Read loop
7399 if Line (J) = ASCII.CR or else Line (J) = ASCII.LF then
7400 N_Read := N_Read - 1;
7406 -- In case the standard RTS is selected do nothing
7408 if N_Read = 0 or else Line (1 .. N_Read) = "." then
7412 -- Otherwise add -margs --RTS=output
7414 Scan_Make_Arg (Env, "-margs", And_Save => True);
7415 Scan_Make_Arg (Env, "--RTS=" & Line (1 .. N_Read), And_Save => True);
7416 end Process_Multilib;
7418 -----------------------------
7419 -- Recursive_Compute_Depth --
7420 -----------------------------
7422 procedure Recursive_Compute_Depth (Project : Project_Id) is
7423 use Project_Boolean_Htable;
7424 Seen : Project_Boolean_Htable.Instance := Project_Boolean_Htable.Nil;
7426 procedure Recurse (Prj : Project_Id; Depth : Natural);
7427 -- Recursive procedure that does the work, keeping track of the depth
7433 procedure Recurse (Prj : Project_Id; Depth : Natural) is
7434 List : Project_List;
7438 if Prj.Depth >= Depth or else Get (Seen, Prj) then
7442 -- We need a test to avoid infinite recursions with limited withs:
7443 -- If we have A -> B -> A, then when set level of A to n, we try and
7444 -- set level of B to n+1, and then level of A to n + 2, ...
7446 Set (Seen, Prj, True);
7450 -- Visit each imported project
7452 List := Prj.Imported_Projects;
7453 while List /= null loop
7454 Proj := List.Project;
7456 Recurse (Prj => Proj, Depth => Depth + 1);
7459 -- We again allow changing the depth of this project later on if it
7460 -- is in fact imported by a lower-level project.
7462 Set (Seen, Prj, False);
7465 Proj : Project_List;
7467 -- Start of processing for Recursive_Compute_Depth
7470 Proj := Project_Tree.Projects;
7471 while Proj /= null loop
7472 Proj.Project.Depth := 0;
7476 Recurse (Project, Depth => 1);
7478 end Recursive_Compute_Depth;
7480 -------------------------------
7481 -- Report_Compilation_Failed --
7482 -------------------------------
7484 procedure Report_Compilation_Failed is
7486 Delete_All_Temp_Files;
7487 Exit_Program (E_Fatal);
7488 end Report_Compilation_Failed;
7490 ------------------------
7491 -- Sigint_Intercepted --
7492 ------------------------
7494 procedure Sigint_Intercepted is
7495 SIGINT : constant := 2;
7499 Write_Line ("*** Interrupted ***");
7501 -- Send SIGINT to all outstanding compilation processes spawned
7503 for J in 1 .. Outstanding_Compiles loop
7504 Kill (Running_Compile (J).Pid, SIGINT, 1);
7507 Delete_All_Temp_Files;
7509 -- ??? OS_Exit (1) is equivalent to Exit_Program (E_No_Compile),
7510 -- shouldn't that be Exit_Program (E_Abort) instead?
7511 end Sigint_Intercepted;
7517 procedure Scan_Make_Arg
7518 (Env : in out Prj.Tree.Environment;
7525 Gnatmake_Switch_Found := True;
7527 pragma Assert (Argv'First = 1);
7529 if Argv'Length = 0 then
7533 -- If the previous switch has set the Project_File_Name_Present flag
7534 -- (that is we have seen a -P alone), then the next argument is the name
7535 -- of the project file.
7537 if Project_File_Name_Present and then Project_File_Name = null then
7538 if Argv (1) = '-' then
7539 Make_Failed ("project file name missing after -P");
7542 Project_File_Name_Present := False;
7543 Project_File_Name := new String'(Argv);
7546 -- If the previous switch has set the Output_File_Name_Present flag
7547 -- (that is we have seen a -o), then the next argument is the name of
7548 -- the output executable.
7550 elsif Output_File_Name_Present
7551 and then not Output_File_Name_Seen
7553 Output_File_Name_Seen := True;
7555 if Argv (1) = '-' then
7556 Make_Failed ("output file name missing after -o");
7559 Add_Switch ("-o", Linker, And_Save => And_Save);
7560 Add_Switch (Executable_Name (Argv), Linker, And_Save => And_Save);
7563 -- If the previous switch has set the Object_Directory_Present flag
7564 -- (that is we have seen a -D), then the next argument is the path name
7565 -- of the object directory.
7567 elsif Object_Directory_Present
7568 and then not Object_Directory_Seen
7570 Object_Directory_Seen := True;
7572 if Argv (1) = '-' then
7573 Make_Failed ("object directory path name missing after -D");
7575 elsif not Is_Directory (Argv) then
7576 Make_Failed ("cannot find object directory """ & Argv & """");
7579 -- Record the object directory. Make sure it ends with a directory
7583 Norm : constant String := Normalize_Pathname (Argv);
7586 if Norm (Norm'Last) = Directory_Separator then
7587 Object_Directory_Path := new String'(Norm);
7589 Object_Directory_Path :=
7590 new String'(Norm & Directory_Separator);
7593 Add_Lib_Search_Dir (Norm);
7595 -- Specify the object directory to the binder
7597 Add_Switch ("-aO" & Norm, Binder, And_Save => And_Save);
7602 -- Then check if we are dealing with -cargs/-bargs/-largs/-margs
7604 elsif Argv = "-bargs"
7613 when 'c' => Program_Args := Compiler;
7614 when 'b' => Program_Args := Binder;
7615 when 'l' => Program_Args := Linker;
7616 when 'm' => Program_Args := None;
7619 raise Program_Error;
7622 -- A special test is needed for the -o switch within a -largs since that
7623 -- is another way to specify the name of the final executable.
7625 elsif Program_Args = Linker
7626 and then Argv = "-o"
7628 Make_Failed ("switch -o not allowed within a -largs. " &
7629 "Use -o directly.");
7631 -- Check to see if we are reading switches after a -cargs, -bargs or
7632 -- -largs switch. If so, save it.
7634 elsif Program_Args /= None then
7636 -- Check to see if we are reading -I switches in order
7637 -- to take into account in the src & lib search directories.
7639 if Argv'Length > 2 and then Argv (1 .. 2) = "-I" then
7640 if Argv (3 .. Argv'Last) = "-" then
7641 Look_In_Primary_Dir := False;
7643 elsif Program_Args = Compiler then
7644 if Argv (3 .. Argv'Last) /= "-" then
7645 Add_Source_Search_Dir (Argv (3 .. Argv'Last), And_Save);
7648 elsif Program_Args = Binder then
7649 Add_Library_Search_Dir (Argv (3 .. Argv'Last), And_Save);
7653 Add_Switch (Argv, Program_Args, And_Save => And_Save);
7655 -- Handle non-default compiler, binder, linker, and handle --RTS switch
7657 elsif Argv'Length > 2 and then Argv (1 .. 2) = "--" then
7659 and then Argv (1 .. 6) = "--GCC="
7662 Program_Args : constant Argument_List_Access :=
7663 Argument_String_To_List
7664 (Argv (7 .. Argv'Last));
7668 Saved_Gcc := new String'(Program_Args.all (1).all);
7670 Gcc := new String'(Program_Args.all (1).all);
7673 for J in 2 .. Program_Args.all'Last loop
7675 (Program_Args.all (J).all, Compiler, And_Save => And_Save);
7679 elsif Argv'Length > 11
7680 and then Argv (1 .. 11) = "--GNATBIND="
7683 Program_Args : constant Argument_List_Access :=
7684 Argument_String_To_List
7685 (Argv (12 .. Argv'Last));
7689 Saved_Gnatbind := new String'(Program_Args.all (1).all);
7691 Gnatbind := new String'(Program_Args.all (1).all);
7694 for J in 2 .. Program_Args.all'Last loop
7696 (Program_Args.all (J).all, Binder, And_Save => And_Save);
7700 elsif Argv'Length > 11
7701 and then Argv (1 .. 11) = "--GNATLINK="
7704 Program_Args : constant Argument_List_Access :=
7705 Argument_String_To_List
7706 (Argv (12 .. Argv'Last));
7709 Saved_Gnatlink := new String'(Program_Args.all (1).all);
7711 Gnatlink := new String'(Program_Args.all (1).all);
7714 for J in 2 .. Program_Args.all'Last loop
7715 Add_Switch (Program_Args.all (J).all, Linker);
7719 elsif Argv'Length >= 5 and then
7720 Argv (1 .. 5) = "--RTS"
7722 Add_Switch (Argv, Compiler, And_Save => And_Save);
7723 Add_Switch (Argv, Binder, And_Save => And_Save);
7725 if Argv'Length <= 6 or else Argv (6) /= '=' then
7726 Make_Failed ("missing path for --RTS");
7729 -- Check that this is the first time we see this switch or
7730 -- if it is not the first time, the same path is specified.
7732 if RTS_Specified = null then
7733 RTS_Specified := new String'(Argv (7 .. Argv'Last));
7735 elsif RTS_Specified.all /= Argv (7 .. Argv'Last) then
7736 Make_Failed ("--RTS cannot be specified multiple times");
7739 -- Valid --RTS switch
7746 Src_Path_Name : constant String_Ptr :=
7748 (Argv (7 .. Argv'Last), Include);
7750 Lib_Path_Name : constant String_Ptr :=
7752 (Argv (7 .. Argv'Last), Objects);
7755 if Src_Path_Name /= null
7756 and then Lib_Path_Name /= null
7758 -- Set RTS_*_Path_Name variables, so that correct direct-
7759 -- ories will be set when Osint.Add_Default_Search_Dirs
7762 RTS_Src_Path_Name := Src_Path_Name;
7763 RTS_Lib_Path_Name := Lib_Path_Name;
7765 elsif Src_Path_Name = null
7766 and then Lib_Path_Name = null
7768 Make_Failed ("RTS path not valid: missing " &
7769 "adainclude and adalib directories");
7771 elsif Src_Path_Name = null then
7772 Make_Failed ("RTS path not valid: missing adainclude " &
7775 elsif Lib_Path_Name = null then
7776 Make_Failed ("RTS path not valid: missing adalib " &
7782 elsif Argv'Length > Source_Info_Option'Length and then
7783 Argv (1 .. Source_Info_Option'Length) = Source_Info_Option
7785 Project_Tree.Source_Info_File_Name :=
7786 new String'(Argv (Source_Info_Option'Length + 1 .. Argv'Last));
7788 elsif Argv'Length >= 8 and then
7789 Argv (1 .. 8) = "--param="
7791 Add_Switch (Argv, Compiler, And_Save => And_Save);
7792 Add_Switch (Argv, Linker, And_Save => And_Save);
7794 elsif Argv = Create_Map_File_Switch then
7795 Map_File := new String'("");
7797 elsif Argv'Length > Create_Map_File_Switch'Length + 1
7799 Argv (1 .. Create_Map_File_Switch'Length) = Create_Map_File_Switch
7801 Argv (Create_Map_File_Switch'Length + 1) = '='
7805 (Argv (Create_Map_File_Switch'Length + 2 .. Argv'Last));
7808 Scan_Make_Switches (Env, Argv, Success);
7811 -- If we have seen a regular switch process it
7813 elsif Argv (1) = '-' then
7814 if Argv'Length = 1 then
7815 Make_Failed ("switch character cannot be followed by a blank");
7817 -- Incorrect switches that should start with "--"
7819 elsif (Argv'Length > 5 and then Argv (1 .. 5) = "-RTS=")
7820 or else (Argv'Length > 5 and then Argv (1 .. 5) = "-GCC=")
7821 or else (Argv'Length > 8 and then Argv (1 .. 7) = "-param=")
7822 or else (Argv'Length > 10 and then Argv (1 .. 10) = "-GNATLINK=")
7823 or else (Argv'Length > 10 and then Argv (1 .. 10) = "-GNATBIND=")
7825 Make_Failed ("option " & Argv & " should start with '--'");
7829 elsif Argv (2 .. Argv'Last) = "I-" then
7830 Look_In_Primary_Dir := False;
7832 -- Forbid -?- or -??- where ? is any character
7834 elsif (Argv'Length = 3 and then Argv (3) = '-')
7835 or else (Argv'Length = 4 and then Argv (4) = '-')
7838 ("trailing ""-"" at the end of " & Argv & " forbidden.");
7842 elsif Argv (2) = 'I' then
7843 Add_Source_Search_Dir (Argv (3 .. Argv'Last), And_Save);
7844 Add_Library_Search_Dir (Argv (3 .. Argv'Last), And_Save);
7845 Add_Switch (Argv, Compiler, And_Save => And_Save);
7846 Add_Switch (Argv, Binder, And_Save => And_Save);
7848 -- -aIdir (to gcc this is like a -I switch)
7850 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aI" then
7851 Add_Source_Search_Dir (Argv (4 .. Argv'Last), And_Save);
7853 ("-I" & Argv (4 .. Argv'Last), Compiler, And_Save => And_Save);
7854 Add_Switch (Argv, Binder, And_Save => And_Save);
7858 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then
7859 Add_Library_Search_Dir (Argv (4 .. Argv'Last), And_Save);
7860 Add_Switch (Argv, Binder, And_Save => And_Save);
7862 -- -aLdir (to gnatbind this is like a -aO switch)
7864 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then
7865 Mark_Directory (Argv (4 .. Argv'Last), Ada_Lib_Dir, And_Save);
7866 Add_Library_Search_Dir (Argv (4 .. Argv'Last), And_Save);
7868 ("-aO" & Argv (4 .. Argv'Last), Binder, And_Save => And_Save);
7872 elsif Argv'Length >= 13 and then Argv (2 .. 13) = "aamp_target=" then
7873 Add_Switch (Argv, Compiler, And_Save => And_Save);
7875 -- Set the aamp_target environment variable so that the binder and
7876 -- linker will use the proper target library. This is consistent
7877 -- with how things work when -aamp_target is passed on the command
7878 -- line to gnaampmake.
7880 Setenv ("aamp_target", Argv (14 .. Argv'Last));
7882 -- -Adir (to gnatbind this is like a -aO switch, to gcc like a -I)
7884 elsif Argv (2) = 'A' then
7885 Mark_Directory (Argv (3 .. Argv'Last), Ada_Lib_Dir, And_Save);
7886 Add_Source_Search_Dir (Argv (3 .. Argv'Last), And_Save);
7887 Add_Library_Search_Dir (Argv (3 .. Argv'Last), And_Save);
7889 ("-I" & Argv (3 .. Argv'Last), Compiler, And_Save => And_Save);
7891 ("-aO" & Argv (3 .. Argv'Last), Binder, And_Save => And_Save);
7895 elsif Argv (2) = 'L' then
7896 Add_Switch (Argv, Linker, And_Save => And_Save);
7898 -- For -gxxx, -pg, -mxxx, -fxxx, -Oxxx, pass the switch to both the
7899 -- compiler and the linker (except for -gnatxxx which is only for the
7900 -- compiler). Some of the -mxxx (for example -m64) and -fxxx (for
7901 -- example -ftest-coverage for gcov) need to be used when compiling
7902 -- the binder generated files, and using all these gcc switches for
7903 -- them should not be a problem. Pass -Oxxx to the linker for LTO.
7906 (Argv (2) = 'g' and then (Argv'Last < 5
7907 or else Argv (2 .. 5) /= "gnat"))
7908 or else Argv (2 .. Argv'Last) = "pg"
7909 or else (Argv (2) = 'm' and then Argv'Last > 2)
7910 or else (Argv (2) = 'f' and then Argv'Last > 2)
7911 or else Argv (2) = 'O'
7913 Add_Switch (Argv, Compiler, And_Save => And_Save);
7914 Add_Switch (Argv, Linker, And_Save => And_Save);
7916 -- The following condition has to be kept synchronized with
7917 -- the Process_Multilib one.
7920 and then Argv /= "-mieee"
7922 N_M_Switch := N_M_Switch + 1;
7925 -- -C=<mapping file>
7927 elsif Argv'Last > 2 and then Argv (2) = 'C' then
7929 if Argv (3) /= '=' or else Argv'Last <= 3 then
7930 Make_Failed ("illegal switch " & Argv);
7933 Gnatmake_Mapping_File := new String'(Argv (4 .. Argv'Last));
7938 elsif Argv'Last = 2 and then Argv (2) = 'D' then
7939 if Project_File_Name /= null then
7941 ("-D cannot be used in conjunction with a project file");
7944 Scan_Make_Switches (Env, Argv, Success);
7949 elsif Argv (2) = 'd' and then Argv'Last = 2 then
7950 Display_Compilation_Progress := True;
7954 elsif Argv'Last = 2 and then Argv (2) = 'i' then
7955 if Project_File_Name /= null then
7957 ("-i cannot be used in conjunction with a project file");
7959 Scan_Make_Switches (Env, Argv, Success);
7962 -- -j (need to save the result)
7964 elsif Argv (2) = 'j' then
7965 Scan_Make_Switches (Env, Argv, Success);
7968 Saved_Maximum_Processes := Maximum_Processes;
7973 elsif Argv (2) = 'm' and then Argv'Last = 2 then
7974 Minimal_Recompilation := True;
7978 elsif Argv (2) = 'u' and then Argv'Last = 2 then
7979 Unique_Compile := True;
7980 Compile_Only := True;
7981 Do_Bind_Step := False;
7982 Do_Link_Step := False;
7986 elsif Argv (2) = 'U'
7987 and then Argv'Last = 2
7989 Unique_Compile_All_Projects := True;
7990 Unique_Compile := True;
7991 Compile_Only := True;
7992 Do_Bind_Step := False;
7993 Do_Link_Step := False;
7995 -- -Pprj or -P prj (only once, and only on the command line)
7997 elsif Argv (2) = 'P' then
7998 if Project_File_Name /= null then
7999 Make_Failed ("cannot have several project files specified");
8001 elsif Object_Directory_Path /= null then
8003 ("-D cannot be used in conjunction with a project file");
8005 elsif In_Place_Mode then
8007 ("-i cannot be used in conjunction with a project file");
8009 elsif not And_Save then
8011 -- It could be a tool other than gnatmake (e.g. gnatdist)
8012 -- or a -P switch inside a project file.
8015 ("either the tool is not ""project-aware"" or " &
8016 "a project file is specified inside a project file");
8018 elsif Argv'Last = 2 then
8020 -- -P is used alone: the project file name is the next option
8022 Project_File_Name_Present := True;
8025 Project_File_Name := new String'(Argv (3 .. Argv'Last));
8028 -- -vPx (verbosity of the parsing of the project files)
8031 and then Argv (2 .. 3) = "vP"
8032 and then Argv (4) in '0' .. '2'
8037 Current_Verbosity := Prj.Default;
8039 Current_Verbosity := Prj.Medium;
8041 Current_Verbosity := Prj.High;
8047 -- -Xext=val (External assignment)
8049 elsif Argv (2) = 'X'
8050 and then Is_External_Assignment (Env, Argv)
8052 -- Is_External_Assignment has side effects when it returns True
8056 -- If -gnath is present, then generate the usage information right
8057 -- now and do not pass this option on to the compiler calls.
8059 elsif Argv = "-gnath" then
8062 -- If -gnatc is specified, make sure the bind and link steps are not
8065 elsif Argv'Length >= 6 and then Argv (2 .. 6) = "gnatc" then
8067 -- If -gnatc is specified, make sure the bind and link steps are
8070 Add_Switch (Argv, Compiler, And_Save => And_Save);
8071 Operating_Mode := Check_Semantics;
8072 Check_Object_Consistency := False;
8073 Compile_Only := True;
8074 Do_Bind_Step := False;
8075 Do_Link_Step := False;
8077 elsif Argv (2 .. Argv'Last) = "nostdlib" then
8079 -- Pass -nstdlib to gnatbind and gnatlink
8082 Add_Switch (Argv, Binder, And_Save => And_Save);
8083 Add_Switch (Argv, Linker, And_Save => And_Save);
8085 elsif Argv (2 .. Argv'Last) = "nostdinc" then
8087 -- Pass -nostdinc to the Compiler and to gnatbind
8090 Add_Switch (Argv, Compiler, And_Save => And_Save);
8091 Add_Switch (Argv, Binder, And_Save => And_Save);
8093 -- All other switches are processed by Scan_Make_Switches. If the
8094 -- call returns with Gnatmake_Switch_Found = False, then the switch
8095 -- is passed to the compiler.
8098 Scan_Make_Switches (Env, Argv, Gnatmake_Switch_Found);
8100 if not Gnatmake_Switch_Found then
8101 Add_Switch (Argv, Compiler, And_Save => And_Save);
8105 -- If not a switch it must be a file name
8109 Main_On_Command_Line := True;
8113 Mains.Add_Main (Argv);
8121 function Switches_Of
8122 (Source_File : File_Name_Type;
8123 Project : Project_Id;
8124 In_Package : Package_Id;
8125 Allow_ALI : Boolean) return Variable_Value
8127 Switches : Variable_Value;
8128 Is_Default : Boolean;
8131 Makeutl.Get_Switches
8132 (Source_File => Source_File,
8133 Source_Lang => Name_Ada,
8134 Source_Prj => Project,
8135 Pkg_Name => Project_Tree.Shared.Packages.Table (In_Package).Name,
8136 Project_Tree => Project_Tree,
8138 Is_Default => Is_Default,
8139 Test_Without_Suffix => True,
8140 Check_ALI_Suffix => Allow_ALI);
8150 if Usage_Needed then
8151 Usage_Needed := False;
8157 -- Make sure that in case of failure, the temp files will be deleted
8159 Prj.Com.Fail := Make_Failed'Access;
8160 MLib.Fail := Make_Failed'Access;