File : 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-2015, 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 Snames; use Snames;
37 with Table;
38 with Types; use Types;
39
40 with GNAT.OS_Lib; use GNAT.OS_Lib;
41
42 package Makeutl is
43
44 type Fail_Proc is access procedure (S : String);
45 -- Pointer to procedure which outputs a failure message
46
47 Root_Environment : Prj.Tree.Environment;
48 -- The environment coming from environment variables and command line
49 -- switches. When we do not have an aggregate project, this is used for
50 -- parsing the project tree. When we have an aggregate project, this is
51 -- used to parse the aggregate project; the latter then generates another
52 -- environment (with additional external values and project path) to parse
53 -- the aggregated projects.
54
55 Default_Config_Name : constant String := "default.cgpr";
56 -- Name of the configuration file used by gprbuild and generated by
57 -- gprconfig by default.
58
59 On_Windows : constant Boolean := Directory_Separator = '\';
60 -- True when on Windows
61
62 Source_Info_Option : constant String := "--source-info=";
63 -- Switch to indicate the source info file
64
65 Subdirs_Option : constant String := "--subdirs=";
66 -- Switch used to indicate that the real directories (object, exec,
67 -- library, ...) are subdirectories of those in the project file.
68
69 Relocate_Build_Tree_Option : constant String := "--relocate-build-tree";
70 -- Switch to build out-of-tree. In this context the object, exec and
71 -- library directories are relocated to the current working directory
72 -- or the directory specified as parameter to this option.
73
74 Root_Dir_Option : constant String := "--root-dir";
75 -- The root directory under which all artifacts (objects, library, ali)
76 -- directory are to be found for the current compilation. This directory
77 -- will be used to relocate artifacts based on this directory. If this
78 -- option is not specificed the default value is the directory of the
79 -- main project.
80
81 Unchecked_Shared_Lib_Imports : constant String :=
82 "--unchecked-shared-lib-imports";
83 -- Command line switch to allow shared library projects to import projects
84 -- that are not shared library projects.
85
86 Single_Compile_Per_Obj_Dir_Switch : constant String :=
87 "--single-compile-per-obj-dir";
88 -- Switch to forbid simultaneous compilations for the same object directory
89 -- when project files are used.
90
91 Create_Map_File_Switch : constant String := "--create-map-file";
92 -- Switch to create a map file when an executable is linked
93
94 No_Exit_Message_Option : constant String := "--no-exit-message";
95 -- Switch to suppress exit error message when there are compilation
96 -- failures. This is useful when a tool, such as gnatprove, silently calls
97 -- the builder and does not want to pollute its output with error messages
98 -- coming from the builder. This is an internal switch.
99
100 Keep_Temp_Files_Option : constant String := "--keep-temp-files";
101 -- Switch to suppress deletion of temp files created by the builder.
102 -- Note that debug switch -gnatdn also has this effect.
103
104 Load_Standard_Base : Boolean := True;
105 -- False when gprbuild is called with --db-
106
107 package Db_Switch_Args is new Table.Table
108 (Table_Component_Type => Name_Id,
109 Table_Index_Type => Integer,
110 Table_Low_Bound => 1,
111 Table_Initial => 200,
112 Table_Increment => 100,
113 Table_Name => "Makegpr.Db_Switch_Args");
114 -- Table of all the arguments of --db switches of gprbuild
115
116 package Directories is new Table.Table
117 (Table_Component_Type => Path_Name_Type,
118 Table_Index_Type => Integer,
119 Table_Low_Bound => 1,
120 Table_Initial => 200,
121 Table_Increment => 100,
122 Table_Name => "Makegpr.Directories");
123 -- Table of all the source or object directories, filled up by
124 -- Get_Directories.
125
126 procedure Add
127 (Option : String_Access;
128 To : in out String_List_Access;
129 Last : in out Natural);
130 procedure Add
131 (Option : String;
132 To : in out String_List_Access;
133 Last : in out Natural);
134 -- Add a string to a list of strings
135
136 function Absolute_Path
137 (Path : Path_Name_Type;
138 Project : Project_Id) return String;
139 -- Returns an absolute path for a configuration pragmas file
140
141 function Create_Binder_Mapping_File
142 (Project_Tree : Project_Tree_Ref) return Path_Name_Type;
143 -- Create a binder mapping file and returns its path name
144
145 function Create_Name (Name : String) return File_Name_Type;
146 function Create_Name (Name : String) return Name_Id;
147 function Create_Name (Name : String) return Path_Name_Type;
148 -- Get an id for a name
149
150 function Base_Name_Index_For
151 (Main : String;
152 Main_Index : Int;
153 Index_Separator : Character) return File_Name_Type;
154 -- Returns the base name of Main, without the extension, followed by the
155 -- Index_Separator followed by the Main_Index if it is non-zero.
156
157 function Executable_Prefix_Path return String;
158 -- Return the absolute path parent directory of the directory where the
159 -- current executable resides, if its directory is named "bin", otherwise
160 -- return an empty string. When a directory is returned, it is guaranteed
161 -- to end with a directory separator.
162
163 procedure Inform (N : Name_Id := No_Name; Msg : String);
164 procedure Inform (N : File_Name_Type; Msg : String);
165 -- Prints out the program name followed by a colon, N and S
166
167 function File_Not_A_Source_Of
168 (Project_Tree : Project_Tree_Ref;
169 Uname : Name_Id;
170 Sfile : File_Name_Type) return Boolean;
171 -- Check that file name Sfile is one of the source of unit Uname. Returns
172 -- True if the unit is in one of the project file, but the file name is not
173 -- one of its source. Returns False otherwise.
174
175 function Check_Source_Info_In_ALI
176 (The_ALI : ALI.ALI_Id;
177 Tree : Project_Tree_Ref) return Name_Id;
178 -- Check whether all file references in ALI are still valid (i.e. the
179 -- source files are still associated with the same units). Return the name
180 -- of the unit if everything is still valid. Return No_Name otherwise.
181
182 procedure Ensure_Absolute_Path
183 (Switch : in out String_Access;
184 Parent : String;
185 Do_Fail : Fail_Proc;
186 For_Gnatbind : Boolean := False;
187 Including_Non_Switch : Boolean := True;
188 Including_RTS : Boolean := False);
189 -- Do nothing if Switch is an absolute path switch. If relative, fail if
190 -- Parent is the empty string, otherwise prepend the path with Parent. This
191 -- subprogram is only used when using project files. If For_Gnatbind is
192 -- True, consider gnatbind specific syntax for -L (not a path, left
193 -- unchanged) and -A (path is optional, preceded with "=" if present).
194 -- If Including_RTS is True, process also switches --RTS=. Do_Fail is
195 -- called in case of error. Using Osint.Fail might be appropriate.
196
197 function Is_Subunit (Source : Source_Id) return Boolean;
198 -- Return True if source is a subunit
199
200 procedure Initialize_Source_Record (Source : Source_Id);
201 -- Get information either about the source file, or the object and
202 -- dependency file, as well as their timestamps.
203
204 function Is_External_Assignment
205 (Env : Prj.Tree.Environment;
206 Argv : String) return Boolean;
207 -- Verify that an external assignment switch is syntactically correct
208 --
209 -- Correct forms are:
210 --
211 -- -Xname=value
212 -- -X"name=other value"
213 --
214 -- Assumptions: 'First = 1, Argv (1 .. 2) = "-X"
215 --
216 -- When this function returns True, the external assignment has been
217 -- entered by a call to Prj.Ext.Add, so that in a project file, External
218 -- ("name") will return "value".
219
220 type Name_Ids is array (Positive range <>) of Name_Id;
221 No_Names : constant Name_Ids := (1 .. 0 => No_Name);
222 -- Name_Ids is used for list of language names in procedure Get_Directories
223 -- below.
224
225 Ada_Only : constant Name_Ids := (1 => Name_Ada);
226 -- Used to invoke Get_Directories in gnatmake
227
228 type Activity_Type is (Compilation, Executable_Binding, SAL_Binding);
229
230 procedure Get_Directories
231 (Project_Tree : Project_Tree_Ref;
232 For_Project : Project_Id;
233 Activity : Activity_Type;
234 Languages : Name_Ids);
235 -- Put in table Directories the source (when Sources is True) or
236 -- object/library (when Sources is False) directories of project
237 -- For_Project and of all the project it imports directly or indirectly.
238 -- The source directories of imported projects are only included if one
239 -- of the declared languages is in the list Languages.
240
241 function Aggregate_Libraries_In (Tree : Project_Tree_Ref) return Boolean;
242 -- Return True iff there is one or more aggregate library projects in
243 -- the project tree Tree.
244
245 procedure Write_Path_File (FD : File_Descriptor);
246 -- Write in the specified open path file the directories in table
247 -- Directories, then closed the path file.
248
249 procedure Get_Switches
250 (Source : Source_Id;
251 Pkg_Name : Name_Id;
252 Project_Tree : Project_Tree_Ref;
253 Value : out Variable_Value;
254 Is_Default : out Boolean);
255 procedure Get_Switches
256 (Source_File : File_Name_Type;
257 Source_Lang : Name_Id;
258 Source_Prj : Project_Id;
259 Pkg_Name : Name_Id;
260 Project_Tree : Project_Tree_Ref;
261 Value : out Variable_Value;
262 Is_Default : out Boolean;
263 Test_Without_Suffix : Boolean := False;
264 Check_ALI_Suffix : Boolean := False);
265 -- Compute the switches (Compilation switches for instance) for the given
266 -- file. This checks various attributes to see if there are file specific
267 -- switches, or else defaults on the switches for the corresponding
268 -- language. Is_Default is set to False if there were file-specific
269 -- switches. Source_File can be set to No_File to force retrieval of the
270 -- default switches. If Test_Without_Suffix is True, and there is no "for
271 -- Switches(Source_File) use", then this procedure also tests without the
272 -- extension of the filename. If Test_Without_Suffix is True and
273 -- Check_ALI_Suffix is True, then we also replace the file extension with
274 -- ".ali" when testing.
275
276 function Linker_Options_Switches
277 (Project : Project_Id;
278 Do_Fail : Fail_Proc;
279 In_Tree : Project_Tree_Ref) return String_List;
280 -- Collect the options specified in the Linker'Linker_Options attributes
281 -- of project Project, in project tree In_Tree, and in the projects that
282 -- it imports directly or indirectly, and returns the result.
283
284 function Path_Or_File_Name (Path : Path_Name_Type) return String;
285 -- Returns a file name if -df is used, otherwise return a path name
286
287 function Unit_Index_Of (ALI_File : File_Name_Type) return Int;
288 -- Find the index of a unit in a source file. Return zero if the file is
289 -- not a multi-unit source file.
290
291 procedure Verbose_Msg
292 (N1 : Name_Id;
293 S1 : String;
294 N2 : Name_Id := No_Name;
295 S2 : String := "";
296 Prefix : String := " -> ";
297 Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low);
298 procedure Verbose_Msg
299 (N1 : File_Name_Type;
300 S1 : String;
301 N2 : File_Name_Type := No_File;
302 S2 : String := "";
303 Prefix : String := " -> ";
304 Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low);
305 -- If the verbose flag (Verbose_Mode) is set and the verbosity level is at
306 -- least equal to Minimum_Verbosity, then print Prefix to standard output
307 -- followed by N1 and S1. If N2 /= No_Name then N2 is printed after S1. S2
308 -- is printed last. Both N1 and N2 are printed in quotation marks. The two
309 -- forms differ only in taking Name_Id or File_Name_Type arguments.
310
311 -------------------------
312 -- Program termination --
313 -------------------------
314
315 procedure Fail_Program
316 (Project_Tree : Project_Tree_Ref;
317 S : String;
318 Flush_Messages : Boolean := True);
319 -- Terminate program with a message and a fatal status code
320
321 procedure Finish_Program
322 (Project_Tree : Project_Tree_Ref;
323 Exit_Code : Osint.Exit_Code_Type := Osint.E_Success;
324 S : String := "");
325 -- Terminate program, with or without a message, setting the status code
326 -- according to Fatal. This properly removes all temporary files.
327
328 --------------
329 -- Switches --
330 --------------
331
332 generic
333 with function Add_Switch
334 (Switch : String;
335 For_Lang : Name_Id;
336 For_Builder : Boolean;
337 Has_Global_Compilation_Switches : Boolean) return Boolean;
338 -- For_Builder is true if we have a builder switch. This function
339 -- should return True in case of success (the switch is valid),
340 -- False otherwise. The error message will be displayed by
341 -- Compute_Builder_Switches itself.
342 --
343 -- Has_Global_Compilation_Switches is True if the attribute
344 -- Global_Compilation_Switches is defined in the project.
345
346 procedure Compute_Builder_Switches
347 (Project_Tree : Project_Tree_Ref;
348 Env : in out Prj.Tree.Environment;
349 Main_Project : Project_Id;
350 Only_For_Lang : Name_Id := No_Name);
351 -- Compute the builder switches and global compilation switches. Every time
352 -- a switch is found in the project, it is passed to Add_Switch. You can
353 -- provide a value for Only_For_Lang so that we only look for this language
354 -- when parsing the global compilation switches.
355
356 -----------------------
357 -- Project_Tree data --
358 -----------------------
359
360 -- The following types are specific to builders, and associated with each
361 -- of the loaded project trees.
362
363 type Binding_Data_Record;
364 type Binding_Data is access Binding_Data_Record;
365 type Binding_Data_Record is record
366 Language : Language_Ptr;
367 Language_Name : Name_Id;
368 Binder_Driver_Name : File_Name_Type;
369 Binder_Driver_Path : String_Access;
370 Binder_Prefix : Name_Id;
371 Next : Binding_Data;
372 end record;
373 -- Data for a language that have a binder driver
374
375 type Builder_Project_Tree_Data is new Project_Tree_Appdata with record
376 Binding : Binding_Data;
377
378 There_Are_Binder_Drivers : Boolean := False;
379 -- True when there is a binder driver. Set by Get_Configuration when
380 -- an attribute Language_Processing'Binder_Driver is declared.
381 -- Reset to False if there are no sources of the languages with binder
382 -- drivers.
383
384 Number_Of_Mains : Natural := 0;
385 -- Number of main units in this project tree
386
387 Closure_Needed : Boolean := False;
388 -- If True, we need to add the closure of the file we just compiled to
389 -- the queue. If False, it is assumed that all files are already on the
390 -- queue so we do not waste time computing the closure.
391
392 Need_Compilation : Boolean := True;
393 Need_Binding : Boolean := True;
394 Need_Linking : Boolean := True;
395 -- Which of the compilation phases are needed for this project tree
396 end record;
397 type Builder_Data_Access is access all Builder_Project_Tree_Data;
398
399 procedure Free (Data : in out Builder_Project_Tree_Data);
400 -- Free all memory allocated for Data
401
402 function Builder_Data (Tree : Project_Tree_Ref) return Builder_Data_Access;
403 -- Return (allocate if needed) tree-specific data
404
405 procedure Compute_Compilation_Phases
406 (Tree : Project_Tree_Ref;
407 Root_Project : Project_Id;
408 Option_Unique_Compile : Boolean := False; -- Was "-u" specified ?
409 Option_Compile_Only : Boolean := False; -- Was "-c" specified ?
410 Option_Bind_Only : Boolean := False;
411 Option_Link_Only : Boolean := False);
412 -- Compute which compilation phases will be needed for Tree. This also does
413 -- the computation for aggregated trees. This also check whether we'll need
414 -- to check the closure of the files we have just compiled to add them to
415 -- the queue.
416
417 -----------
418 -- Mains --
419 -----------
420
421 -- Package Mains is used to store the mains specified on the command line
422 -- and to retrieve them when a project file is used, to verify that the
423 -- files exist and that they belong to a project file.
424
425 -- Mains are stored in a table. An index is used to retrieve the mains
426 -- from the table.
427
428 type Main_Info is record
429 File : File_Name_Type; -- Always canonical casing
430 Index : Int := 0;
431 Location : Source_Ptr := No_Location;
432
433 Source : Prj.Source_Id := No_Source;
434 Project : Project_Id;
435 Tree : Project_Tree_Ref;
436 end record;
437
438 No_Main_Info : constant Main_Info :=
439 (No_File, 0, No_Location, No_Source, No_Project, null);
440
441 package Mains is
442 procedure Add_Main
443 (Name : String;
444 Index : Int := 0;
445 Location : Source_Ptr := No_Location;
446 Project : Project_Id := No_Project;
447 Tree : Project_Tree_Ref := null);
448 -- Add one main to the table. This is in general used to add the main
449 -- files specified on the command line. Index is used for multi-unit
450 -- source files, and indicates which unit in the source is concerned.
451 -- Location is the location within the project file (if a project file
452 -- is used). Project and Tree indicate to which project the main should
453 -- belong. In particular, for aggregate projects, this isn't necessarily
454 -- the main project tree. These can be set to No_Project and null when
455 -- not using projects.
456
457 procedure Delete;
458 -- Empty the table
459
460 procedure Reset;
461 -- Reset the cursor to the beginning of the table
462
463 procedure Set_Multi_Unit_Index
464 (Project_Tree : Project_Tree_Ref := null;
465 Index : Int := 0);
466 -- If a single main file was defined, this subprogram indicates which
467 -- unit inside it is the main (case of a multi-unit source files).
468 -- Errors are raised if zero or more than one main file was defined,
469 -- and Index is non-zaero. This subprogram is used for the handling
470 -- of the command line switch.
471
472 function Next_Main return String;
473 function Next_Main return Main_Info;
474 -- Moves the cursor forward and returns the new current entry. Returns
475 -- No_Main_Info there are no more mains in the table.
476
477 function Number_Of_Mains (Tree : Project_Tree_Ref) return Natural;
478 -- Returns the number of mains in this project tree (if Tree is null, it
479 -- returns the total number of project trees).
480
481 procedure Fill_From_Project
482 (Root_Project : Project_Id;
483 Project_Tree : Project_Tree_Ref);
484 -- If no main was already added (presumably from the command line), add
485 -- the main units from root_project (or in the case of an aggregate
486 -- project from all the aggregated projects).
487
488 procedure Complete_Mains
489 (Flags : Processing_Flags;
490 Root_Project : Project_Id;
491 Project_Tree : Project_Tree_Ref);
492 -- If some main units were already added from the command line, check
493 -- that they all belong to the root project, and that they are full
494 -- paths rather than (partial) base names (e.g. no body suffix was
495 -- specified).
496
497 end Mains;
498
499 -----------
500 -- Queue --
501 -----------
502
503 type Source_Info_Format is (Format_Gprbuild, Format_Gnatmake);
504
505 package Queue is
506
507 -- The queue of sources to be checked for compilation. There can be a
508 -- single such queue per application.
509
510 type Source_Info (Format : Source_Info_Format := Format_Gprbuild) is
511 record
512 case Format is
513 when Format_Gprbuild =>
514 Tree : Project_Tree_Ref := No_Project_Tree;
515 Id : Source_Id := No_Source;
516 Closure : Boolean := False;
517
518 when Format_Gnatmake =>
519 File : File_Name_Type := No_File;
520 Unit : Unit_Name_Type := No_Unit_Name;
521 Index : Int := 0;
522 Project : Project_Id := No_Project;
523 Sid : Source_Id := No_Source;
524 end case;
525 end record;
526 -- Information about files stored in the queue. The exact information
527 -- depends on the builder, and in particular whether it only supports
528 -- project-based files (in which case we have a full Source_Id record).
529
530 No_Source_Info : constant Source_Info :=
531 (Format_Gprbuild, null, null, False);
532
533 procedure Initialize
534 (Queue_Per_Obj_Dir : Boolean;
535 Force : Boolean := False);
536 -- Initialize the queue
537 --
538 -- Queue_Per_Obj_Dir matches the --single-compile-per-obj-dir switch:
539 -- when True, there cannot be simultaneous compilations with the object
540 -- files in the same object directory when project files are used.
541 --
542 -- Nothing is done if Force is False and the queue was already
543 -- initialized.
544
545 procedure Remove_Marks;
546 -- Remove all marks set for the files. This means that the files will be
547 -- handed to the compiler if they are added to the queue, and is mostly
548 -- useful when recompiling several executables in non-project mode, as
549 -- the switches may be different and -s may be in use.
550
551 function Is_Empty return Boolean;
552 -- Returns True if the queue is empty
553
554 function Is_Virtually_Empty return Boolean;
555 -- Returns True if queue is empty or if all object directories are busy
556
557 procedure Insert (Source : Source_Info; With_Roots : Boolean := False);
558 function Insert
559 (Source : Source_Info; With_Roots : Boolean := False) return Boolean;
560 -- Insert source in the queue. The second version returns False if the
561 -- Source was already marked in the queue. If With_Roots is True and the
562 -- source is in Format_Gprbuild mode (ie with a project), this procedure
563 -- also includes the "Roots" for this main, ie all the other files that
564 -- must be included in the library or binary (in particular to combine
565 -- Ada and C files connected through pragma Export/Import). When the
566 -- roots are computed, they are also stored in the corresponding
567 -- Source_Id for later reuse by the binder.
568
569 procedure Insert_Project_Sources
570 (Project : Project_Id;
571 Project_Tree : Project_Tree_Ref;
572 All_Projects : Boolean;
573 Unique_Compile : Boolean);
574 -- Insert all the compilable sources of the project in the queue. If
575 -- All_Project is true, then all sources from imported projects are also
576 -- inserted. Unique_Compile should be true if "-u" was specified on the
577 -- command line: if True and some files were given on the command line),
578 -- only those files will be compiled (so Insert_Project_Sources will do
579 -- nothing). If True and no file was specified on the command line, all
580 -- files of the project(s) will be compiled. This procedure also
581 -- processed aggregated projects.
582
583 procedure Insert_Withed_Sources_For
584 (The_ALI : ALI.ALI_Id;
585 Project_Tree : Project_Tree_Ref;
586 Excluding_Shared_SALs : Boolean := False);
587 -- Insert in the queue those sources withed by The_ALI, if there are not
588 -- already in the queue and Only_Interfaces is False or they are part of
589 -- the interfaces of their project.
590
591 procedure Extract
592 (Found : out Boolean;
593 Source : out Source_Info);
594 -- Get the first source that can be compiled from the queue. If no
595 -- source may be compiled, sets Found to False. In this case, the value
596 -- for Source is undefined.
597
598 function Size return Natural;
599 -- Return the total size of the queue, including the sources already
600 -- extracted.
601
602 function Processed return Natural;
603 -- Return the number of source in the queue that have aready been
604 -- processed.
605
606 procedure Set_Obj_Dir_Busy (Obj_Dir : Path_Name_Type);
607 procedure Set_Obj_Dir_Free (Obj_Dir : Path_Name_Type);
608 -- Mark Obj_Dir as busy or free (see the parameter to Initialize)
609
610 function Element (Rank : Positive) return File_Name_Type;
611 -- Get the file name for element of index Rank in the queue
612
613 end Queue;
614
615 end Makeutl;