1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- M A K E _ U T I L -- 6-- -- 7-- S p e c -- 8-- -- 9-- Copyright (C) 2004-2019, 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 build queue management. 28 29with Namet; use Namet; 30with Opt; 31with Osint; 32with Types; use Types; 33 34with GNAT.OS_Lib; use GNAT.OS_Lib; 35 36package Make_Util is 37 38 type Fail_Proc is access procedure (S : String); 39 -- Pointer to procedure which outputs a failure message 40 41 -- Root_Environment : Prj.Tree.Environment; 42 -- The environment coming from environment variables and command line 43 -- switches. When we do not have an aggregate project, this is used for 44 -- parsing the project tree. When we have an aggregate project, this is 45 -- used to parse the aggregate project; the latter then generates another 46 -- environment (with additional external values and project path) to parse 47 -- the aggregated projects. 48 49 -- Default_Config_Name : constant String := "default.cgpr"; 50 -- Name of the configuration file used by gprbuild and generated by 51 -- gprconfig by default. 52 53 On_Windows : constant Boolean := Directory_Separator = '\'; 54 -- True when on Windows 55 56 Source_Info_Option : constant String := "--source-info="; 57 -- Switch to indicate the source info file 58 59 Subdirs_Option : constant String := "--subdirs="; 60 -- Switch used to indicate that the real directories (object, exec, 61 -- library, ...) are subdirectories of those in the project file. 62 63 Relocate_Build_Tree_Option : constant String := "--relocate-build-tree"; 64 -- Switch to build out-of-tree. In this context the object, exec and 65 -- library directories are relocated to the current working directory 66 -- or the directory specified as parameter to this option. 67 68 Unchecked_Shared_Lib_Imports : constant String := 69 "--unchecked-shared-lib-imports"; 70 -- Command line switch to allow shared library projects to import projects 71 -- that are not shared library projects. 72 73 Single_Compile_Per_Obj_Dir_Switch : constant String := 74 "--single-compile-per-obj-dir"; 75 -- Switch to forbid simultaneous compilations for the same object directory 76 -- when project files are used. 77 78 Create_Map_File_Switch : constant String := "--create-map-file"; 79 -- Switch to create a map file when an executable is linked 80 81 No_Exit_Message_Option : constant String := "--no-exit-message"; 82 -- Switch to suppress exit error message when there are compilation 83 -- failures. This is useful when a tool, such as gnatprove, silently calls 84 -- the builder and does not want to pollute its output with error messages 85 -- coming from the builder. This is an internal switch. 86 87 Keep_Temp_Files_Option : constant String := "--keep-temp-files"; 88 -- Switch to suppress deletion of temp files created by the builder. 89 -- Note that debug switch -gnatdn also has this effect. 90 91 procedure Add 92 (Option : String_Access; 93 To : in out String_List_Access; 94 Last : in out Natural); 95 procedure Add 96 (Option : String; 97 To : in out String_List_Access; 98 Last : in out Natural); 99 -- Add a string to a list of strings 100 101 function Create_Name (Name : String) return File_Name_Type; 102 function Create_Name (Name : String) return Name_Id; 103 function Create_Name (Name : String) return Path_Name_Type; 104 -- Get an id for a name 105 106 function Base_Name_Index_For 107 (Main : String; 108 Main_Index : Int; 109 Index_Separator : Character) return File_Name_Type; 110 -- Returns the base name of Main, without the extension, followed by the 111 -- Index_Separator followed by the Main_Index if it is non-zero. 112 113 function Executable_Prefix_Path return String; 114 -- Return the absolute path parent directory of the directory where the 115 -- current executable resides, if its directory is named "bin", otherwise 116 -- return an empty string. When a directory is returned, it is guaranteed 117 -- to end with a directory separator. 118 119 procedure Inform (N : Name_Id := No_Name; Msg : String); 120 procedure Inform (N : File_Name_Type; Msg : String); 121 -- Prints out the program name followed by a colon, N and S 122 123 procedure Ensure_Absolute_Path 124 (Switch : in out String_Access; 125 Parent : String; 126 Do_Fail : Fail_Proc; 127 For_Gnatbind : Boolean := False; 128 Including_Non_Switch : Boolean := True; 129 Including_RTS : Boolean := False); 130 -- Do nothing if Switch is an absolute path switch. If relative, fail if 131 -- Parent is the empty string, otherwise prepend the path with Parent. This 132 -- subprogram is only used when using project files. If For_Gnatbind is 133 -- True, consider gnatbind specific syntax for -L (not a path, left 134 -- unchanged) and -A (path is optional, preceded with "=" if present). 135 -- If Including_RTS is True, process also switches --RTS=. Do_Fail is 136 -- called in case of error. Using Osint.Fail might be appropriate. 137 138 type Name_Ids is array (Positive range <>) of Name_Id; 139 No_Names : constant Name_Ids := (1 .. 0 => No_Name); 140 -- Name_Ids is used for list of language names in procedure Get_Directories 141 -- below. 142 143 function Path_Or_File_Name (Path : Path_Name_Type) return String; 144 -- Returns a file name if -df is used, otherwise return a path name 145 146 function Unit_Index_Of (ALI_File : File_Name_Type) return Int; 147 -- Find the index of a unit in a source file. Return zero if the file is 148 -- not a multi-unit source file. 149 150 procedure Verbose_Msg 151 (N1 : Name_Id; 152 S1 : String; 153 N2 : Name_Id := No_Name; 154 S2 : String := ""; 155 Prefix : String := " -> "; 156 Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low); 157 procedure Verbose_Msg 158 (N1 : File_Name_Type; 159 S1 : String; 160 N2 : File_Name_Type := No_File; 161 S2 : String := ""; 162 Prefix : String := " -> "; 163 Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low); 164 -- If the verbose flag (Verbose_Mode) is set and the verbosity level is at 165 -- least equal to Minimum_Verbosity, then print Prefix to standard output 166 -- followed by N1 and S1. If N2 /= No_Name then N2 is printed after S1. S2 167 -- is printed last. Both N1 and N2 are printed in quotation marks. The two 168 -- forms differ only in taking Name_Id or File_Name_Type arguments. 169 170 Max_Header_Num : constant := 6150; 171 type Header_Num is range 0 .. Max_Header_Num; 172 -- Size for hash table below. The upper bound is an arbitrary value, the 173 -- value here was chosen after testing to determine a good compromise 174 -- between speed of access and memory usage. 175 176 function Hash (Name : Name_Id) return Header_Num; 177 function Hash (Name : File_Name_Type) return Header_Num; 178 function Hash (Name : Path_Name_Type) return Header_Num; 179 180 ------------------------- 181 -- Program termination -- 182 ------------------------- 183 184 procedure Fail_Program 185 (S : String; 186 Flush_Messages : Boolean := True); 187 pragma No_Return (Fail_Program); 188 -- Terminate program with a message and a fatal status code 189 190 procedure Finish_Program 191 (Exit_Code : Osint.Exit_Code_Type := Osint.E_Success; 192 S : String := ""); 193 pragma No_Return (Finish_Program); 194 -- Terminate program, with or without a message, setting the status code 195 -- according to Fatal. This properly removes all temporary files. 196 197 ----------- 198 -- Mains -- 199 ----------- 200 201 -- Package Mains is used to store the mains specified on the command line 202 -- and to retrieve them when a project file is used, to verify that the 203 -- files exist and that they belong to a project file. 204 205 -- Mains are stored in a table. An index is used to retrieve the mains 206 -- from the table. 207 208 type Main_Info is record 209 File : File_Name_Type; -- Always canonical casing 210 Index : Int := 0; 211 end record; 212 213 No_Main_Info : constant Main_Info := (No_File, 0); 214 215 package Mains is 216 procedure Add_Main (Name : String; Index : Int := 0); 217 -- Add one main to the table. This is in general used to add the main 218 -- files specified on the command line. Index is used for multi-unit 219 -- source files, and indicates which unit in the source is concerned. 220 221 procedure Delete; 222 -- Empty the table 223 224 procedure Reset; 225 -- Reset the cursor to the beginning of the table 226 227 procedure Set_Multi_Unit_Index 228 (Index : Int := 0); 229 -- If a single main file was defined, this subprogram indicates which 230 -- unit inside it is the main (case of a multi-unit source files). 231 -- Errors are raised if zero or more than one main file was defined, 232 -- and Index is non-zaero. This subprogram is used for the handling 233 -- of the command line switch. 234 235 function Next_Main return String; 236 function Next_Main return Main_Info; 237 -- Moves the cursor forward and returns the new current entry. Returns 238 -- No_Main_Info there are no more mains in the table. 239 240 function Number_Of_Mains return Natural; 241 -- Returns the number of main. 242 243 end Mains; 244 245 ----------- 246 -- Queue -- 247 ----------- 248 249 package Queue is 250 251 -- The queue of sources to be checked for compilation. There can be a 252 -- single such queue per application. 253 254 type Source_Info is 255 record 256 File : File_Name_Type := No_File; 257 Unit : Unit_Name_Type := No_Unit_Name; 258 Index : Int := 0; 259 end record; 260 -- Information about files stored in the queue. 261 262 No_Source_Info : constant Source_Info := (No_File, No_Unit_Name, 0); 263 264 procedure Initialize (Force : Boolean := False); 265 -- Initialize the queue 266 267 procedure Remove_Marks; 268 -- Remove all marks set for the files. This means that the files will be 269 -- handed to the compiler if they are added to the queue, and is mostly 270 -- useful when recompiling several executables as the switches may be 271 -- different and -s may be in use. 272 273 function Is_Empty return Boolean; 274 -- Returns True if the queue is empty 275 276 procedure Insert (Source : Source_Info); 277 function Insert (Source : Source_Info) return Boolean; 278 -- Insert source in the queue. The second version returns False if the 279 -- Source was already marked in the queue. 280 281 procedure Extract 282 (Found : out Boolean; 283 Source : out Source_Info); 284 -- Get the first source that can be compiled from the queue. If no 285 -- source may be compiled, sets Found to False. In this case, the value 286 -- for Source is undefined. 287 288 function Size return Natural; 289 -- Return the total size of the queue, including the sources already 290 -- extracted. 291 292 function Processed return Natural; 293 -- Return the number of source in the queue that have aready been 294 -- processed. 295 296 function Element (Rank : Positive) return File_Name_Type; 297 -- Get the file name for element of index Rank in the queue 298 299 end Queue; 300 301end Make_Util; 302