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 30with ALI; 31with Namet; use Namet; 32with Opt; 33with Osint; 34with Prj; use Prj; 35with Prj.Tree; 36with Snames; use Snames; 37with Table; 38with Types; use Types; 39 40with GNAT.OS_Lib; use GNAT.OS_Lib; 41 42package 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 615end Makeutl; 616