]> git.ipfire.org Git - thirdparty/gcc.git/blob - gcc/ada/makeutl.ads
[multiple changes]
[thirdparty/gcc.git] / gcc / ada / makeutl.ads
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- M A K E U T L --
6 -- --
7 -- S p e c --
8 -- --
9 -- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
20 -- --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
23 -- --
24 ------------------------------------------------------------------------------
25
26 -- This package contains various subprograms used by the builders, in
27 -- particular those subprograms related to project management and build
28 -- queue management.
29
30 with ALI;
31 with Namet; use Namet;
32 with Opt;
33 with Osint;
34 with Prj; use Prj;
35 with Prj.Tree;
36 with Types; use Types;
37
38 with GNAT.OS_Lib; use GNAT.OS_Lib;
39
40 package Makeutl is
41
42 type Fail_Proc is access procedure (S : String);
43 -- Pointer to procedure which outputs a failure message
44
45 On_Windows : constant Boolean := Directory_Separator = '\';
46 -- True when on Windows
47
48 Source_Info_Option : constant String := "--source-info=";
49 -- Switch to indicate the source info file
50
51 Subdirs_Option : constant String := "--subdirs=";
52 -- Switch used to indicate that the real directories (object, exec,
53 -- library, ...) are subdirectories of those in the project file.
54
55 Unchecked_Shared_Lib_Imports : constant String :=
56 "--unchecked-shared-lib-imports";
57 -- Command line switch to allow shared library projects to import projects
58 -- that are not shared library projects.
59
60 Single_Compile_Per_Obj_Dir_Switch : constant String :=
61 "--single-compile-per-obj-dir";
62 -- Switch to forbid simultaneous compilations for the same object directory
63 -- when project files are used.
64
65 Create_Map_File_Switch : constant String := "--create-map-file";
66 -- Switch to create a map file when an executable is linked
67
68 procedure Add
69 (Option : String_Access;
70 To : in out String_List_Access;
71 Last : in out Natural);
72 procedure Add
73 (Option : String;
74 To : in out String_List_Access;
75 Last : in out Natural);
76 -- Add a string to a list of strings
77
78 function Create_Binder_Mapping_File
79 (Project_Tree : Project_Tree_Ref) return Path_Name_Type;
80 -- Create a binder mapping file and returns its path name
81
82 function Create_Name (Name : String) return File_Name_Type;
83 function Create_Name (Name : String) return Name_Id;
84 function Create_Name (Name : String) return Path_Name_Type;
85 -- Get an id for a name
86
87 function Base_Name_Index_For
88 (Main : String;
89 Main_Index : Int;
90 Index_Separator : Character) return File_Name_Type;
91 -- Returns the base name of Main, without the extension, followed by the
92 -- Index_Separator followed by the Main_Index if it is non-zero.
93
94 function Executable_Prefix_Path return String;
95 -- Return the absolute path parent directory of the directory where the
96 -- current executable resides, if its directory is named "bin", otherwise
97 -- return an empty string. When a directory is returned, it is guaranteed
98 -- to end with a directory separator.
99
100 procedure Inform (N : Name_Id := No_Name; Msg : String);
101 procedure Inform (N : File_Name_Type; Msg : String);
102 -- Prints out the program name followed by a colon, N and S
103
104 function File_Not_A_Source_Of
105 (Project_Tree : Project_Tree_Ref;
106 Uname : Name_Id;
107 Sfile : File_Name_Type) return Boolean;
108 -- Check that file name Sfile is one of the source of unit Uname. Returns
109 -- True if the unit is in one of the project file, but the file name is not
110 -- one of its source. Returns False otherwise.
111
112 function Check_Source_Info_In_ALI
113 (The_ALI : ALI.ALI_Id;
114 Tree : Project_Tree_Ref) return Boolean;
115 -- Check whether all file references in ALI are still valid (i.e. the
116 -- source files are still associated with the same units). Return True
117 -- if everything is still valid.
118
119 function Is_Subunit (Source : Source_Id) return Boolean;
120 -- Return True if source is a subunit
121
122 procedure Initialize_Source_Record (Source : Source_Id);
123 -- Get information either about the source file, or the object and
124 -- dependency file, as well as their timestamps.
125
126 function Is_External_Assignment
127 (Env : Prj.Tree.Environment;
128 Argv : String) return Boolean;
129 -- Verify that an external assignment switch is syntactically correct
130 --
131 -- Correct forms are:
132 --
133 -- -Xname=value
134 -- -X"name=other value"
135 --
136 -- Assumptions: 'First = 1, Argv (1 .. 2) = "-X"
137 --
138 -- When this function returns True, the external assignment has been
139 -- entered by a call to Prj.Ext.Add, so that in a project file, External
140 -- ("name") will return "value".
141
142 procedure Verbose_Msg
143 (N1 : Name_Id;
144 S1 : String;
145 N2 : Name_Id := No_Name;
146 S2 : String := "";
147 Prefix : String := " -> ";
148 Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low);
149 procedure Verbose_Msg
150 (N1 : File_Name_Type;
151 S1 : String;
152 N2 : File_Name_Type := No_File;
153 S2 : String := "";
154 Prefix : String := " -> ";
155 Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low);
156 -- If the verbose flag (Verbose_Mode) is set and the verbosity level is at
157 -- least equal to Minimum_Verbosity, then print Prefix to standard output
158 -- followed by N1 and S1. If N2 /= No_Name then N2 is printed after S1. S2
159 -- is printed last. Both N1 and N2 are printed in quotation marks. The two
160 -- forms differ only in taking Name_Id or File_name_Type arguments.
161
162 procedure Get_Switches
163 (Source : Source_Id;
164 Pkg_Name : Name_Id;
165 Project_Tree : Project_Tree_Ref;
166 Value : out Variable_Value;
167 Is_Default : out Boolean);
168 procedure Get_Switches
169 (Source_File : File_Name_Type;
170 Source_Lang : Name_Id;
171 Source_Prj : Project_Id;
172 Pkg_Name : Name_Id;
173 Project_Tree : Project_Tree_Ref;
174 Value : out Variable_Value;
175 Is_Default : out Boolean;
176 Test_Without_Suffix : Boolean := False;
177 Check_ALI_Suffix : Boolean := False);
178 -- Compute the switches (Compilation switches for instance) for the given
179 -- file. This checks various attributes to see if there are file specific
180 -- switches, or else defaults on the switches for the corresponding
181 -- language. Is_Default is set to False if there were file-specific
182 -- switches Source_File can be set to No_File to force retrieval of the
183 -- default switches. If Test_Without_Suffix is True, and there is no " for
184 -- Switches(Source_File) use", then this procedure also tests without the
185 -- extension of the filename. If Test_Without_Suffix is True and
186 -- Check_ALI_Suffix is True, then we also replace the file extension with
187 -- ".ali" when testing.
188
189 function Linker_Options_Switches
190 (Project : Project_Id;
191 Do_Fail : Fail_Proc;
192 In_Tree : Project_Tree_Ref) return String_List;
193 -- Collect the options specified in the Linker'Linker_Options attributes
194 -- of project Project, in project tree In_Tree, and in the projects that
195 -- it imports directly or indirectly, and returns the result.
196
197 function Unit_Index_Of (ALI_File : File_Name_Type) return Int;
198 -- Find the index of a unit in a source file. Return zero if the file is
199 -- not a multi-unit source file.
200
201 procedure Test_If_Relative_Path
202 (Switch : in out String_Access;
203 Parent : String;
204 Do_Fail : Fail_Proc;
205 Including_L_Switch : Boolean := True;
206 Including_Non_Switch : Boolean := True;
207 Including_RTS : Boolean := False);
208 -- Test if Switch is a relative search path switch. If so, fail if Parent
209 -- is the empty string, otherwise prepend the path with Parent. This
210 -- subprogram is only used when using project files. For gnatbind switches,
211 -- Including_L_Switch is False, because the argument of the -L switch is
212 -- not a path. If Including_RTS is True, process also switches --RTS=.
213 -- Do_Fail is called in case of error. Using Osint.Fail might be
214 -- appropriate.
215
216 function Path_Or_File_Name (Path : Path_Name_Type) return String;
217 -- Returns a file name if -df is used, otherwise return a path name
218
219 -------------------------
220 -- Program termination --
221 -------------------------
222
223 procedure Fail_Program
224 (Project_Tree : Project_Tree_Ref;
225 S : String;
226 Flush_Messages : Boolean := True);
227 -- Terminate program with a message and a fatal status code
228
229 procedure Finish_Program
230 (Project_Tree : Project_Tree_Ref;
231 Exit_Code : Osint.Exit_Code_Type := Osint.E_Success;
232 S : String := "");
233 -- Terminate program, with or without a message, setting the status code
234 -- according to Fatal. This properly removes all temporary files.
235
236 -----------------------
237 -- Project_Tree data --
238 -----------------------
239
240 -- The following types are specific to builders, and associated with each
241 -- of the loaded project trees.
242
243 type Binding_Data_Record;
244 type Binding_Data is access Binding_Data_Record;
245 type Binding_Data_Record is record
246 Language : Language_Ptr;
247 Language_Name : Name_Id;
248 Binder_Driver_Name : File_Name_Type;
249 Binder_Driver_Path : String_Access;
250 Binder_Prefix : Name_Id;
251 Next : Binding_Data;
252 end record;
253 -- Data for a language that have a binder driver
254
255 type Builder_Project_Tree_Data is new Project_Tree_Appdata with record
256 Binding : Binding_Data;
257
258 There_Are_Binder_Drivers : Boolean := False;
259 -- True when there is a binder driver. Set by Get_Configuration when
260 -- an attribute Language_Processing'Binder_Driver is declared.
261 -- Reset to False if there are no sources of the languages with binder
262 -- drivers.
263
264 Number_Of_Mains : Natural := 0;
265 -- Number of main units in this project tree
266
267 Closure_Needed : Boolean := False;
268 -- If True, we need to add the closure of the file we just compiled to
269 -- the queue. If False, it is assumed that all files are already on the
270 -- queue so we do not waste time computing the closure.
271
272 Need_Compilation : Boolean := True;
273 Need_Binding : Boolean := True;
274 Need_Linking : Boolean := True;
275 -- Which of the compilation phases are needed for this project tree.
276 end record;
277 type Builder_Data_Access is access all Builder_Project_Tree_Data;
278
279 procedure Free (Data : in out Builder_Project_Tree_Data);
280 -- Free all memory allocated for Data
281
282 function Builder_Data (Tree : Project_Tree_Ref) return Builder_Data_Access;
283 -- Return (allocate if needed) tree-specific data
284
285 procedure Compute_Compilation_Phases
286 (Tree : Project_Tree_Ref;
287 Root_Project : Project_Id;
288 Option_Unique_Compile : Boolean := False; -- Was "-u" specified ?
289 Option_Compile_Only : Boolean := False; -- Was "-c" specified ?
290 Option_Bind_Only : Boolean := False;
291 Option_Link_Only : Boolean := False);
292 -- Compute which compilation phases will be needed for Tree. This also does
293 -- the computation for aggregated trees. This also check whether we'll need
294 -- to check the closure of the files we have just compiled to add them to
295 -- the queue.
296
297 -----------
298 -- Mains --
299 -----------
300
301 -- Package Mains is used to store the mains specified on the command line
302 -- and to retrieve them when a project file is used, to verify that the
303 -- files exist and that they belong to a project file.
304
305 -- Mains are stored in a table. An index is used to retrieve the mains
306 -- from the table.
307
308 type Main_Info is record
309 File : File_Name_Type; -- Always canonical casing
310 Index : Int := 0;
311 Location : Source_Ptr := No_Location;
312
313 Source : Prj.Source_Id := No_Source;
314 Project : Project_Id;
315 Tree : Project_Tree_Ref;
316 end record;
317
318 No_Main_Info : constant Main_Info :=
319 (No_File, 0, No_Location, No_Source, No_Project, null);
320
321 package Mains is
322 procedure Add_Main
323 (Name : String;
324 Index : Int := 0;
325 Location : Source_Ptr := No_Location;
326 Project : Project_Id := No_Project;
327 Tree : Project_Tree_Ref := null);
328 -- Add one main to the table. This is in general used to add the main
329 -- files specified on the command line. Index is used for multi-unit
330 -- source files, and indicates which unit in the source is concerned.
331 -- Location is the location within the project file (if a project file
332 -- is used). Project and Tree indicate to which project the main should
333 -- belong. In particular, for aggregate projects, this isn't necessarily
334 -- the main project tree. These can be set to No_Project and null when
335 -- not using projects.
336
337 procedure Delete;
338 -- Empty the table
339
340 procedure Reset;
341 -- Reset the cursor to the beginning of the table
342
343 procedure Set_Multi_Unit_Index
344 (Project_Tree : Project_Tree_Ref := null;
345 Index : Int := 0);
346 -- If a single main file was defined, this subprogram indicates which
347 -- unit inside it is the main (case of a multi-unit source files).
348 -- Errors are raised if zero or more than one main file was defined,
349 -- and Index is non-zaero. This subprogram is used for the handling
350 -- of the command line switch.
351
352 function Next_Main return String;
353 function Next_Main return Main_Info;
354 -- Moves the cursor forward and returns the new current entry. Returns
355 -- No_File_And_Loc if there are no more mains in the table.
356
357 function Number_Of_Mains (Tree : Project_Tree_Ref) return Natural;
358 -- Returns the number of mains in this project tree (if Tree is null, it
359 -- returns the total number of project trees)
360
361 procedure Fill_From_Project
362 (Root_Project : Project_Id;
363 Project_Tree : Project_Tree_Ref);
364 -- If no main was already added (presumably from the command line), add
365 -- the main units from root_project (or in the case of an aggregate
366 -- project from all the aggregated projects).
367
368 procedure Complete_Mains
369 (Flags : Processing_Flags;
370 Root_Project : Project_Id;
371 Project_Tree : Project_Tree_Ref);
372 -- If some main units were already added from the command line, check
373 -- that they all belong to the root project, and that they are full
374 -- paths rather than (partial) base names (e.g. no body suffix was
375 -- specified).
376
377 end Mains;
378
379 -----------
380 -- Queue --
381 -----------
382
383 type Source_Info_Format is (Format_Gprbuild, Format_Gnatmake);
384
385 package Queue is
386
387 -- The queue of sources to be checked for compilation. There can be a
388 -- single such queue per application.
389
390 type Source_Info (Format : Source_Info_Format := Format_Gprbuild) is
391 record
392 case Format is
393 when Format_Gprbuild =>
394 Tree : Project_Tree_Ref := null;
395 Id : Source_Id := null;
396
397 when Format_Gnatmake =>
398 File : File_Name_Type := No_File;
399 Unit : Unit_Name_Type := No_Unit_Name;
400 Index : Int := 0;
401 Project : Project_Id := No_Project;
402 end case;
403 end record;
404 -- Information about files stored in the queue. The exact information
405 -- depends on the builder, and in particular whether it only supports
406 -- project-based files (in which case we have a full Source_Id record).
407
408 No_Source_Info : constant Source_Info := (Format_Gprbuild, null, null);
409
410 procedure Initialize
411 (Queue_Per_Obj_Dir : Boolean;
412 Force : Boolean := False);
413 -- Initialize the queue.
414 -- Queue_Per_Obj_Dir matches the --single-compile-per-obj-dir switch:
415 -- when True, there cannot be simultaneous compilations with the object
416 -- files in the same object directory when project files are used.
417 --
418 -- Nothing is done if Force is False and the queue was already
419 -- initialized.
420
421 procedure Remove_Marks;
422 -- Remove all marks set for the files.
423 -- This means that the files will be handed to the compiler if they are
424 -- added to the queue, and is mostly useful when recompiling several
425 -- executables in non-project mode, as the switches may be different
426 -- and -s may be in use.
427
428 function Is_Empty return Boolean;
429 -- Returns True if the queue is empty
430
431 function Is_Virtually_Empty return Boolean;
432 -- Returns True if queue is empty or if all object directories are busy
433
434 procedure Insert (Source : Source_Info; With_Roots : Boolean := False);
435 function Insert
436 (Source : Source_Info; With_Roots : Boolean := False) return Boolean;
437 -- Insert source in the queue. The second version returns False if the
438 -- Source was already marked in the queue. If With_Roots is True and the
439 -- source is in Format_Gprbuild mode (ie with a project), this procedure
440 -- also includes the "Roots" for this main, ie all the other files that
441 -- must be included in the library or binary (in particular to combine
442 -- Ada and C files connected through pragma Export/Import). When the
443 -- roots are computed, they are also stored in the corresponding
444 -- Source_Id for later reuse by the binder.
445
446 procedure Insert_Project_Sources
447 (Project : Project_Id;
448 Project_Tree : Project_Tree_Ref;
449 All_Projects : Boolean;
450 Unique_Compile : Boolean);
451 -- Insert all the compilable sources of the project in the queue. If
452 -- All_Project is true, then all sources from imported projects are also
453 -- inserted. Unique_Compile should be true if "-u" was specified on the
454 -- command line: if True and some files were given on the command line),
455 -- only those files will be compiled (so Insert_Project_Sources will do
456 -- nothing). If True and no file was specified on the command line, all
457 -- files of the project(s) will be compiled. This procedure also
458 -- processed aggregated projects.
459
460 procedure Insert_Withed_Sources_For
461 (The_ALI : ALI.ALI_Id;
462 Project_Tree : Project_Tree_Ref;
463 Excluding_Shared_SALs : Boolean := False);
464 -- Insert in the queue those sources withed by The_ALI, if there are not
465 -- already in the queue and Only_Interfaces is False or they are part of
466 -- the interfaces of their project.
467
468 procedure Extract
469 (Found : out Boolean;
470 Source : out Source_Info);
471 -- Get the first source that can be compiled from the queue. If no
472 -- source may be compiled, sets Found to False. In this case, the value
473 -- for Source is undefined.
474
475 function Size return Natural;
476 -- Return the total size of the queue, including the sources already
477 -- extracted.
478
479 function Processed return Natural;
480 -- Return the number of source in the queue that have aready been
481 -- processed.
482
483 procedure Set_Obj_Dir_Busy (Obj_Dir : Path_Name_Type);
484 procedure Set_Obj_Dir_Free (Obj_Dir : Path_Name_Type);
485 -- Mark Obj_Dir as busy or free (see the parameter to Initialize)
486
487 function Element (Rank : Positive) return File_Name_Type;
488 -- Get the file name for element of index Rank in the queue
489
490 end Queue;
491
492 end Makeutl;