1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2004-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 ------------------------------------------------------------------------------
26 -- This package contains various subprograms used by the builders, in
27 -- particular those subprograms related to project management and build
31 with Namet; use Namet;
36 with Snames; use Snames;
38 with Types; use Types;
40 with GNAT.OS_Lib; use GNAT.OS_Lib;
44 type Fail_Proc is access procedure (S : String);
45 -- Pointer to procedure which outputs a failure message
47 On_Windows : constant Boolean := Directory_Separator = '\';
48 -- True when on Windows
50 Source_Info_Option : constant String := "--source-info=";
51 -- Switch to indicate the source info file
53 Subdirs_Option : constant String := "--subdirs=";
54 -- Switch used to indicate that the real directories (object, exec,
55 -- library, ...) are subdirectories of those in the project file.
57 Unchecked_Shared_Lib_Imports : constant String :=
58 "--unchecked-shared-lib-imports";
59 -- Command line switch to allow shared library projects to import projects
60 -- that are not shared library projects.
62 Single_Compile_Per_Obj_Dir_Switch : constant String :=
63 "--single-compile-per-obj-dir";
64 -- Switch to forbid simultaneous compilations for the same object directory
65 -- when project files are used.
67 Create_Map_File_Switch : constant String := "--create-map-file";
68 -- Switch to create a map file when an executable is linked
70 package Directories is new Table.Table
71 (Table_Component_Type => Path_Name_Type,
72 Table_Index_Type => Integer,
75 Table_Increment => 100,
76 Table_Name => "Makegpr.Directories");
77 -- Table of all the source or object directories, filled up by
81 (Option : String_Access;
82 To : in out String_List_Access;
83 Last : in out Natural);
86 To : in out String_List_Access;
87 Last : in out Natural);
88 -- Add a string to a list of strings
90 function Create_Binder_Mapping_File
91 (Project_Tree : Project_Tree_Ref) return Path_Name_Type;
92 -- Create a binder mapping file and returns its path name
94 function Create_Name (Name : String) return File_Name_Type;
95 function Create_Name (Name : String) return Name_Id;
96 function Create_Name (Name : String) return Path_Name_Type;
97 -- Get an id for a name
99 function Base_Name_Index_For
102 Index_Separator : Character) return File_Name_Type;
103 -- Returns the base name of Main, without the extension, followed by the
104 -- Index_Separator followed by the Main_Index if it is non-zero.
106 function Executable_Prefix_Path return String;
107 -- Return the absolute path parent directory of the directory where the
108 -- current executable resides, if its directory is named "bin", otherwise
109 -- return an empty string. When a directory is returned, it is guaranteed
110 -- to end with a directory separator.
112 procedure Inform (N : Name_Id := No_Name; Msg : String);
113 procedure Inform (N : File_Name_Type; Msg : String);
114 -- Prints out the program name followed by a colon, N and S
116 function File_Not_A_Source_Of
117 (Project_Tree : Project_Tree_Ref;
119 Sfile : File_Name_Type) return Boolean;
120 -- Check that file name Sfile is one of the source of unit Uname. Returns
121 -- True if the unit is in one of the project file, but the file name is not
122 -- one of its source. Returns False otherwise.
124 function Check_Source_Info_In_ALI
125 (The_ALI : ALI.ALI_Id;
126 Tree : Project_Tree_Ref) return Boolean;
127 -- Check whether all file references in ALI are still valid (i.e. the
128 -- source files are still associated with the same units). Return True
129 -- if everything is still valid.
131 function Is_Subunit (Source : Source_Id) return Boolean;
132 -- Return True if source is a subunit
134 procedure Initialize_Source_Record (Source : Source_Id);
135 -- Get information either about the source file, or the object and
136 -- dependency file, as well as their timestamps.
138 function Is_External_Assignment
139 (Env : Prj.Tree.Environment;
140 Argv : String) return Boolean;
141 -- Verify that an external assignment switch is syntactically correct
143 -- Correct forms are:
146 -- -X"name=other value"
148 -- Assumptions: 'First = 1, Argv (1 .. 2) = "-X"
150 -- When this function returns True, the external assignment has been
151 -- entered by a call to Prj.Ext.Add, so that in a project file, External
152 -- ("name") will return "value".
154 procedure Verbose_Msg
157 N2 : Name_Id := No_Name;
159 Prefix : String := " -> ";
160 Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low);
161 procedure Verbose_Msg
162 (N1 : File_Name_Type;
164 N2 : File_Name_Type := No_File;
166 Prefix : String := " -> ";
167 Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low);
168 -- If the verbose flag (Verbose_Mode) is set and the verbosity level is at
169 -- least equal to Minimum_Verbosity, then print Prefix to standard output
170 -- followed by N1 and S1. If N2 /= No_Name then N2 is printed after S1. S2
171 -- is printed last. Both N1 and N2 are printed in quotation marks. The two
172 -- forms differ only in taking Name_Id or File_name_Type arguments.
174 type Name_Ids is array (Positive range <>) of Name_Id;
175 No_Names : constant Name_Ids := (1 .. 0 => No_Name);
176 -- Name_Ids is used for list of language names in procedure Get_Directories
179 Ada_Only : constant Name_Ids := (1 => Name_Ada);
180 -- Used to invoke Get_Directories in gnatmake
182 type Activity_Type is (Compilation, Executable_Binding, SAL_Binding);
184 procedure Get_Directories
185 (Project_Tree : Project_Tree_Ref;
186 For_Project : Project_Id;
187 Activity : Activity_Type;
188 Languages : Name_Ids);
189 -- Put in table Directories the source (when Sources is True) or
190 -- object/library (when Sources is False) directories of project
191 -- For_Project and of all the project it imports directly or indirectly.
192 -- The source directories of imported projects are only included if one
193 -- of the declared languages is in the list Languages.
195 procedure Write_Path_File (FD : File_Descriptor);
196 -- Write in the specified open path file the directories in table
197 -- Directories, then closed the path file.
199 procedure Get_Switches
202 Project_Tree : Project_Tree_Ref;
203 Value : out Variable_Value;
204 Is_Default : out Boolean);
205 procedure Get_Switches
206 (Source_File : File_Name_Type;
207 Source_Lang : Name_Id;
208 Source_Prj : Project_Id;
210 Project_Tree : Project_Tree_Ref;
211 Value : out Variable_Value;
212 Is_Default : out Boolean;
213 Test_Without_Suffix : Boolean := False;
214 Check_ALI_Suffix : Boolean := False);
215 -- Compute the switches (Compilation switches for instance) for the given
216 -- file. This checks various attributes to see if there are file specific
217 -- switches, or else defaults on the switches for the corresponding
218 -- language. Is_Default is set to False if there were file-specific
219 -- switches Source_File can be set to No_File to force retrieval of the
220 -- default switches. If Test_Without_Suffix is True, and there is no " for
221 -- Switches(Source_File) use", then this procedure also tests without the
222 -- extension of the filename. If Test_Without_Suffix is True and
223 -- Check_ALI_Suffix is True, then we also replace the file extension with
224 -- ".ali" when testing.
226 function Linker_Options_Switches
227 (Project : Project_Id;
229 In_Tree : Project_Tree_Ref) return String_List;
230 -- Collect the options specified in the Linker'Linker_Options attributes
231 -- of project Project, in project tree In_Tree, and in the projects that
232 -- it imports directly or indirectly, and returns the result.
234 function Unit_Index_Of (ALI_File : File_Name_Type) return Int;
235 -- Find the index of a unit in a source file. Return zero if the file is
236 -- not a multi-unit source file.
238 procedure Test_If_Relative_Path
239 (Switch : in out String_Access;
242 Including_L_Switch : Boolean := True;
243 Including_Non_Switch : Boolean := True;
244 Including_RTS : Boolean := False);
245 -- Test if Switch is a relative search path switch. If so, fail if Parent
246 -- is the empty string, otherwise prepend the path with Parent. This
247 -- subprogram is only used when using project files. For gnatbind switches,
248 -- Including_L_Switch is False, because the argument of the -L switch is
249 -- not a path. If Including_RTS is True, process also switches --RTS=.
250 -- Do_Fail is called in case of error. Using Osint.Fail might be
253 function Path_Or_File_Name (Path : Path_Name_Type) return String;
254 -- Returns a file name if -df is used, otherwise return a path name
256 -------------------------
257 -- Program termination --
258 -------------------------
260 procedure Fail_Program
261 (Project_Tree : Project_Tree_Ref;
263 Flush_Messages : Boolean := True);
264 -- Terminate program with a message and a fatal status code
266 procedure Finish_Program
267 (Project_Tree : Project_Tree_Ref;
268 Exit_Code : Osint.Exit_Code_Type := Osint.E_Success;
270 -- Terminate program, with or without a message, setting the status code
271 -- according to Fatal. This properly removes all temporary files.
278 with function Add_Switch
281 For_Builder : Boolean;
282 Has_Global_Compilation_Switches : Boolean) return Boolean;
283 -- For_Builder is true if we have a builder switch
284 -- This function should return True in case of success (the switch is
285 -- valid), False otherwise. The error message will be displayed by
286 -- Compute_Builder_Switches itself.
287 -- Has_Global_Compilation_Switches is True if the attribute
288 -- Global_Compilation_Switches is defined in the project.
290 procedure Compute_Builder_Switches
291 (Project_Tree : Project_Tree_Ref;
292 Root_Environment : in out Prj.Tree.Environment;
293 Main_Project : Project_Id;
294 Only_For_Lang : Name_Id := No_Name);
295 -- Compute the builder switches and global compilation switches.
296 -- Every time a switch is found in the project, it is passed to Add_Switch.
297 -- You can provide a value for Only_For_Lang so that we only look for
298 -- this language when parsing the global compilation switches.
300 -----------------------
301 -- Project_Tree data --
302 -----------------------
304 -- The following types are specific to builders, and associated with each
305 -- of the loaded project trees.
307 type Binding_Data_Record;
308 type Binding_Data is access Binding_Data_Record;
309 type Binding_Data_Record is record
310 Language : Language_Ptr;
311 Language_Name : Name_Id;
312 Binder_Driver_Name : File_Name_Type;
313 Binder_Driver_Path : String_Access;
314 Binder_Prefix : Name_Id;
317 -- Data for a language that have a binder driver
319 type Builder_Project_Tree_Data is new Project_Tree_Appdata with record
320 Binding : Binding_Data;
322 There_Are_Binder_Drivers : Boolean := False;
323 -- True when there is a binder driver. Set by Get_Configuration when
324 -- an attribute Language_Processing'Binder_Driver is declared.
325 -- Reset to False if there are no sources of the languages with binder
328 Number_Of_Mains : Natural := 0;
329 -- Number of main units in this project tree
331 Closure_Needed : Boolean := False;
332 -- If True, we need to add the closure of the file we just compiled to
333 -- the queue. If False, it is assumed that all files are already on the
334 -- queue so we do not waste time computing the closure.
336 Need_Compilation : Boolean := True;
337 Need_Binding : Boolean := True;
338 Need_Linking : Boolean := True;
339 -- Which of the compilation phases are needed for this project tree
341 type Builder_Data_Access is access all Builder_Project_Tree_Data;
343 procedure Free (Data : in out Builder_Project_Tree_Data);
344 -- Free all memory allocated for Data
346 function Builder_Data (Tree : Project_Tree_Ref) return Builder_Data_Access;
347 -- Return (allocate if needed) tree-specific data
349 procedure Compute_Compilation_Phases
350 (Tree : Project_Tree_Ref;
351 Root_Project : Project_Id;
352 Option_Unique_Compile : Boolean := False; -- Was "-u" specified ?
353 Option_Compile_Only : Boolean := False; -- Was "-c" specified ?
354 Option_Bind_Only : Boolean := False;
355 Option_Link_Only : Boolean := False);
356 -- Compute which compilation phases will be needed for Tree. This also does
357 -- the computation for aggregated trees. This also check whether we'll need
358 -- to check the closure of the files we have just compiled to add them to
365 -- Package Mains is used to store the mains specified on the command line
366 -- and to retrieve them when a project file is used, to verify that the
367 -- files exist and that they belong to a project file.
369 -- Mains are stored in a table. An index is used to retrieve the mains
372 type Main_Info is record
373 File : File_Name_Type; -- Always canonical casing
375 Location : Source_Ptr := No_Location;
377 Source : Prj.Source_Id := No_Source;
378 Project : Project_Id;
379 Tree : Project_Tree_Ref;
382 No_Main_Info : constant Main_Info :=
383 (No_File, 0, No_Location, No_Source, No_Project, null);
389 Location : Source_Ptr := No_Location;
390 Project : Project_Id := No_Project;
391 Tree : Project_Tree_Ref := null);
392 -- Add one main to the table. This is in general used to add the main
393 -- files specified on the command line. Index is used for multi-unit
394 -- source files, and indicates which unit in the source is concerned.
395 -- Location is the location within the project file (if a project file
396 -- is used). Project and Tree indicate to which project the main should
397 -- belong. In particular, for aggregate projects, this isn't necessarily
398 -- the main project tree. These can be set to No_Project and null when
399 -- not using projects.
405 -- Reset the cursor to the beginning of the table
407 procedure Set_Multi_Unit_Index
408 (Project_Tree : Project_Tree_Ref := null;
410 -- If a single main file was defined, this subprogram indicates which
411 -- unit inside it is the main (case of a multi-unit source files).
412 -- Errors are raised if zero or more than one main file was defined,
413 -- and Index is non-zaero. This subprogram is used for the handling
414 -- of the command line switch.
416 function Next_Main return String;
417 function Next_Main return Main_Info;
418 -- Moves the cursor forward and returns the new current entry. Returns
419 -- No_Main_Info there are no more mains in the table.
421 function Number_Of_Mains (Tree : Project_Tree_Ref) return Natural;
422 -- Returns the number of mains in this project tree (if Tree is null, it
423 -- returns the total number of project trees)
425 procedure Fill_From_Project
426 (Root_Project : Project_Id;
427 Project_Tree : Project_Tree_Ref);
428 -- If no main was already added (presumably from the command line), add
429 -- the main units from root_project (or in the case of an aggregate
430 -- project from all the aggregated projects).
432 procedure Complete_Mains
433 (Flags : Processing_Flags;
434 Root_Project : Project_Id;
435 Project_Tree : Project_Tree_Ref);
436 -- If some main units were already added from the command line, check
437 -- that they all belong to the root project, and that they are full
438 -- paths rather than (partial) base names (e.g. no body suffix was
447 type Source_Info_Format is (Format_Gprbuild, Format_Gnatmake);
451 -- The queue of sources to be checked for compilation. There can be a
452 -- single such queue per application.
454 type Source_Info (Format : Source_Info_Format := Format_Gprbuild) is
457 when Format_Gprbuild =>
458 Tree : Project_Tree_Ref := null;
459 Id : Source_Id := null;
461 when Format_Gnatmake =>
462 File : File_Name_Type := No_File;
463 Unit : Unit_Name_Type := No_Unit_Name;
465 Project : Project_Id := No_Project;
468 -- Information about files stored in the queue. The exact information
469 -- depends on the builder, and in particular whether it only supports
470 -- project-based files (in which case we have a full Source_Id record).
472 No_Source_Info : constant Source_Info := (Format_Gprbuild, null, null);
475 (Queue_Per_Obj_Dir : Boolean;
476 Force : Boolean := False);
477 -- Initialize the queue
479 -- Queue_Per_Obj_Dir matches the --single-compile-per-obj-dir switch:
480 -- when True, there cannot be simultaneous compilations with the object
481 -- files in the same object directory when project files are used.
483 -- Nothing is done if Force is False and the queue was already
486 procedure Remove_Marks;
487 -- Remove all marks set for the files. This means that the files will be
488 -- handed to the compiler if they are added to the queue, and is mostly
489 -- useful when recompiling several executables in non-project mode, as
490 -- the switches may be different and -s may be in use.
492 function Is_Empty return Boolean;
493 -- Returns True if the queue is empty
495 function Is_Virtually_Empty return Boolean;
496 -- Returns True if queue is empty or if all object directories are busy
498 procedure Insert (Source : Source_Info; With_Roots : Boolean := False);
500 (Source : Source_Info; With_Roots : Boolean := False) return Boolean;
501 -- Insert source in the queue. The second version returns False if the
502 -- Source was already marked in the queue. If With_Roots is True and the
503 -- source is in Format_Gprbuild mode (ie with a project), this procedure
504 -- also includes the "Roots" for this main, ie all the other files that
505 -- must be included in the library or binary (in particular to combine
506 -- Ada and C files connected through pragma Export/Import). When the
507 -- roots are computed, they are also stored in the corresponding
508 -- Source_Id for later reuse by the binder.
510 procedure Insert_Project_Sources
511 (Project : Project_Id;
512 Project_Tree : Project_Tree_Ref;
513 All_Projects : Boolean;
514 Unique_Compile : Boolean);
515 -- Insert all the compilable sources of the project in the queue. If
516 -- All_Project is true, then all sources from imported projects are also
517 -- inserted. Unique_Compile should be true if "-u" was specified on the
518 -- command line: if True and some files were given on the command line),
519 -- only those files will be compiled (so Insert_Project_Sources will do
520 -- nothing). If True and no file was specified on the command line, all
521 -- files of the project(s) will be compiled. This procedure also
522 -- processed aggregated projects.
524 procedure Insert_Withed_Sources_For
525 (The_ALI : ALI.ALI_Id;
526 Project_Tree : Project_Tree_Ref;
527 Excluding_Shared_SALs : Boolean := False);
528 -- Insert in the queue those sources withed by The_ALI, if there are not
529 -- already in the queue and Only_Interfaces is False or they are part of
530 -- the interfaces of their project.
533 (Found : out Boolean;
534 Source : out Source_Info);
535 -- Get the first source that can be compiled from the queue. If no
536 -- source may be compiled, sets Found to False. In this case, the value
537 -- for Source is undefined.
539 function Size return Natural;
540 -- Return the total size of the queue, including the sources already
543 function Processed return Natural;
544 -- Return the number of source in the queue that have aready been
547 procedure Set_Obj_Dir_Busy (Obj_Dir : Path_Name_Type);
548 procedure Set_Obj_Dir_Free (Obj_Dir : Path_Name_Type);
549 -- Mark Obj_Dir as busy or free (see the parameter to Initialize)
551 function Element (Rank : Positive) return File_Name_Type;
552 -- Get the file name for element of index Rank in the queue