1------------------------------------------------------------------------------ 2-- -- 3-- GPR TECHNOLOGY -- 4-- -- 5-- Copyright (C) 2007-2016, AdaCore -- 6-- -- 7-- This is free software; you can redistribute it and/or modify it under -- 8-- terms of the GNU General Public License as published by the Free Soft- -- 9-- ware Foundation; either version 3, or (at your option) any later ver- -- 10-- sion. This software is distributed in the hope that it will be useful, -- 11-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 12-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public -- 13-- License for more details. You should have received a copy of the GNU -- 14-- General Public License distributed with GNAT; see file COPYING. If not, -- 15-- see <http://www.gnu.org/licenses/>. -- 16-- -- 17------------------------------------------------------------------------------ 18 19-- This package contains constants, variable and subprograms used by gprbuild 20-- and gprclean. 21 22with Ada.Calendar; use Ada; 23 24with GNAT.HTable; 25with GNAT.MD5; use GNAT.MD5; 26with GNAT.OS_Lib; use GNAT.OS_Lib; 27 28with GPR.ALI; 29with GPR; use GPR; 30 31package Gpr_Util is 32 33 Partial_Prefix : constant String := "p__"; 34 35 Begin_Info : constant String := "-- BEGIN Object file/option list"; 36 End_Info : constant String := "-- END Object file/option list "; 37 38 Project_Node_Tree : constant GPR.Project_Node_Tree_Ref := 39 new Project_Node_Tree_Data; 40 -- This is also used to hold project path and scenario variables 41 42 Success : Boolean := False; 43 44 Complete_Output_Option : constant String := "--complete-output"; 45 46 Added_Project : constant String := "--added-project="; 47 48 Complete_Output : Boolean := False; 49 -- Set to True with switch Complete_Output_Option 50 51 -- Config project 52 53 Config_Project_Option : constant String := "--config="; 54 55 Autoconf_Project_Option : constant String := "--autoconf="; 56 57 Target_Project_Option : constant String := "--target="; 58 59 Prefix_Project_Option : constant String := "--prefix"; 60 61 No_Name_Map_File_Option : constant String := "--map-file-option"; 62 63 Restricted_To_Languages_Option : constant String := 64 "--restricted-to-languages="; 65 66 Distributed_Option : constant String := "--distributed"; 67 Hash_Option : constant String := "--hash"; 68 Hash_Value : String_Access; 69 70 Slave_Env_Option : constant String := "--slave-env"; 71 Slave_Env_Auto : Boolean := False; 72 73 Dry_Run_Option : constant String := "--dry-run"; 74 75 Named_Map_File_Option : constant String := No_Name_Map_File_Option & '='; 76 77 Config_Path : String_Access := null; 78 79 Target_Name : String_Access := null; 80 81 Config_Project_File_Name : String_Access := null; 82 Configuration_Project_Path : String_Access := null; 83 -- Base name and full path to the configuration project file 84 85 Autoconfiguration : Boolean := True; 86 -- Whether we are using an automatically config (from gprconfig) 87 88 Autoconf_Specified : Boolean := False; 89 -- Whether the user specified --autoconf on the gprbuild command line 90 91 Delete_Autoconf_File : Boolean := False; 92 -- This variable is used by gprclean to decide if the config project file 93 -- should be cleaned. It is set to True when the config project file is 94 -- automatically generated or --autoconf= is used. 95 96 -- Default project 97 98 Default_Project_File_Name : constant String := "default.gpr"; 99 100 -- Implicit project 101 102 Implicit_Project_File_Path : constant String := 103 "share" & 104 Directory_Separator & 105 "gpr" & 106 Directory_Separator & 107 '_' & 108 Default_Project_File_Name; 109 110 -- User projects 111 112 Project_File_Name : String_Access := null; 113 -- The name of the project file specified with switch -P 114 115 No_Project_File_Found : Boolean := False; 116 -- True when no project file is specified and there is no .gpr file 117 -- in the current working directory. 118 119 Main_Project : Project_Id; 120 -- The project id of the main project 121 122 RTS_Option : constant String := "--RTS="; 123 124 RTS_Language_Option : constant String := "--RTS:"; 125 126 Db_Directory_Expected : Boolean := False; 127 -- True when last switch was --db 128 129 Distributed_Mode : Boolean := False; 130 -- Wether the distributed compilation mode has been activated 131 132 Slave_Env : String_Access; 133 -- The name of the distributed build environment 134 135 -- Packages of project files where unknown attributes are errors 136 137 Naming_String : aliased String := "naming"; 138 Builder_String : aliased String := "builder"; 139 Compiler_String : aliased String := "compiler"; 140 Binder_String : aliased String := "binder"; 141 Linker_String : aliased String := "linker"; 142 Clean_String : aliased String := "clean"; 143 -- Name of packages to be checked when parsing/processing project files 144 145 List_Of_Packages : aliased String_List := 146 (Naming_String'Access, 147 Builder_String'Access, 148 Compiler_String'Access, 149 Binder_String'Access, 150 Linker_String'Access, 151 Clean_String'Access); 152 Packages_To_Check : constant String_List_Access := List_Of_Packages'Access; 153 -- List of the packages to be checked when parsing/processing project files 154 155 Gprname_Packages : aliased String_List := (1 => Naming_String'Access); 156 157 Packages_To_Check_By_Gprname : constant String_List_Access := 158 Gprname_Packages'Access; 159 160 -- Local subprograms 161 162 function Binder_Exchange_File_Name 163 (Main_Base_Name : File_Name_Type; Prefix : Name_Id) return String_Access; 164 -- Returns the name of the binder exchange file corresponding to an 165 -- object file and a language. 166 -- Main_Base_Name must have no extension specified 167 168 procedure Create_Response_File 169 (Format : Response_File_Format; 170 Objects : String_List; 171 Other_Arguments : String_List; 172 Resp_File_Options : String_List; 173 Name_1 : out Path_Name_Type; 174 Name_2 : out Path_Name_Type); 175 -- Create a temporary file as a response file that contains either the list 176 -- of Objects in the correct Format, or for Format GCC the list of all 177 -- arguments. It is the responsibility of the caller to delete this 178 -- temporary file if needed. 179 180 procedure Create_Export_Symbols_File 181 (Driver_Path : String; 182 Options : Argument_List; 183 Sym_Matcher : String; 184 Format : Export_File_Format; 185 Objects : String_List; 186 Library_Symbol_File : String; 187 Export_File_Name : out Path_Name_Type); 188 -- Create an export symbols file for the linker. If Library_Symbol_File is 189 -- defined the symbols will be read from this file (one per line) otherwise 190 -- the symbols from the listed object files will get exported from a shared 191 -- libraries. All other symbols will remain local to the shared library. 192 -- Driver_Path is the tool used to list the symbols from an object file. 193 -- Options are the options needed by the driver. Sym_Matcher is the regular 194 -- expression used to match the symbol out of the tool output. Format 195 -- the the export file format to generate. Objects is the list of object 196 -- files to use. Finally the generated export filename is returned in 197 -- Export_File. 198 199 ---------- 200 -- Misc -- 201 ---------- 202 203 procedure Create_Sym_Links 204 (Lib_Path : String; 205 Lib_Version : String; 206 Lib_Dir : String; 207 Maj_Version : String); 208 -- Copy Lib_Version to Lib_Path (removing Lib_Path if it exists). If 209 -- Maj_Version is set it also link Lib_Version into Lib_Dir with the 210 -- specified Maj_Version. 211 212 procedure Create_Sym_Link (From, To : String); 213 -- Create a relative symlink in From pointing to To 214 215 procedure Display_Usage_Version_And_Help; 216 -- Output the two lines of usage for switches --version and --help 217 218 procedure Display_Version 219 (Tool_Name : String; 220 Initial_Year : String; 221 Version_String : String); 222 -- Display version of a tool when switch --version is used 223 224 generic 225 with procedure Usage; 226 -- Print tool-specific part of --help message 227 procedure Check_Version_And_Help_G 228 (Tool_Name : String; 229 Initial_Year : String; 230 Version_String : String); 231 -- Check if switches --version or --help is used. If one of this switch is 232 -- used, issue the proper messages and end the process. 233 234 procedure Find_Binding_Languages 235 (Tree : Project_Tree_Ref; 236 Root_Project : Project_Id); 237 -- Check if in the project tree there are sources of languages that have 238 -- a binder driver. 239 -- Populates Tree's appdata (Binding and There_Are_Binder_Drivers). 240 -- Nothing is done if the binding languages were already searched for 241 -- this Tree. 242 -- This also performs the check for aggregated project trees. 243 244 function Get_Compiler_Driver_Path 245 (Project_Tree : Project_Tree_Ref; 246 Lang : Language_Ptr) return String_Access; 247 -- Get, from the config, the path of the compiler driver. This is first 248 -- looked for on the PATH if needed. 249 -- Returns "null" if no compiler driver was specified for the language, and 250 -- exit with an error if one was specified but not found. 251 -- 252 -- The --compiler-subst switch is taken into account. For example, if 253 -- "--compiler-subst=ada,gnatpp" was given, and Lang is the Ada language, 254 -- this will return the full path name for gnatpp. 255 256 procedure Locate_Runtime 257 (Project_Tree : Project_Tree_Ref; 258 Language : Name_Id); 259 -- Wrapper around Set_Runtime_For. Search RTS name in the project path and 260 -- if found convert it to an absolute path. Emit an error message if a 261 -- full RTS name (an RTS name that contains a directory separator) is not 262 -- found. 263 264 procedure Look_For_Default_Project (Never_Fail : Boolean := False); 265 -- Check if default.gpr exists in the current directory. If it does, use 266 -- it. Otherwise, if there is only one file ending with .gpr, use it. 267 -- Otherwise, if there is no file ending with .gpr or if Never_Fail is 268 -- True, use the project file _default.gpr in <prefix>/share/gpr. Fail 269 -- if Never_Fail is False and there are several files ending with .gpr. 270 271 function Major_Id_Name 272 (Lib_Filename : String; 273 Lib_Version : String) return String; 274 -- Returns the major id library file name, if it exists. 275 -- For example, if Lib_Filename is "libtoto.so" and Lib_Version is 276 -- "libtoto.so.1.2", then "libtoto.so.1" is returned. 277 278 function Object_Project (Project : Project_Id) return Project_Id; 279 -- For a non aggregate project, returns the project. 280 -- For an aggrete project or an aggregate library project, returns an 281 -- aggregated project that is not an aggregate project. 282 283 function Partial_Name 284 (Lib_Name : String; 285 Number : Natural; 286 Object_Suffix : String) return String; 287 -- Returns the name of an object file created by the partial linker 288 289 function Shared_Libgcc_Dir (Run_Time_Dir : String) return String; 290 -- Returns the directory of the shared version of libgcc, if it can be 291 -- found, otherwise returns an empty string. 292 293 package Knowledge is 294 295 function Normalized_Hostname return String; 296 -- Return the normalized name of the host on which gprbuild is running. 297 -- The knowledge base must have been parsed first. 298 299 procedure Parse_Knowledge_Base 300 (Project_Tree : Project_Tree_Ref; 301 Directory : String := ""); 302 303 end Knowledge; 304 305 procedure Need_To_Compile 306 (Source : Source_Id; 307 Tree : Project_Tree_Ref; 308 In_Project : Project_Id; 309 Must_Compile : out Boolean; 310 The_ALI : out ALI.ALI_Id; 311 Object_Check : Boolean; 312 Always_Compile : Boolean); 313 -- Check if a source need to be compiled. 314 -- A source need to be compiled if: 315 -- - Force_Compilations is True 316 -- - No object file generated for the language 317 -- - Object file does not exist 318 -- - Dependency file does not exist 319 -- - Switches file does not exist 320 -- - Either of these 3 files are older than the source or any source it 321 -- depends on. 322 -- If an ALI file had to be parsed, it is returned as The_ALI, so that the 323 -- caller does not need to parse it again. 324 -- 325 -- Object_Check should be False when switch --no-object-check is used. When 326 -- True, presence of the object file and its time stamp are checked to 327 -- decide if a file needs to be compiled. 328 -- 329 -- Tree is the project tree in which Source is found (or the root tree when 330 -- not using aggregate projects). 331 -- 332 -- Always_Compile should be True when gprbuid is called with -f -u and at 333 -- least one source on the command line. 334 335 function Project_Compilation_Failed 336 (Prj : Project_Id; 337 Recursive : Boolean := True) return Boolean; 338 -- Returns True if all compilations for Prj (and all projects it depends on 339 -- if Recursive is True) were successful and False otherwise. 340 341 procedure Set_Failed_Compilation_Status (Prj : Project_Id); 342 -- Record compilation failure status for the given project 343 344 Maximum_Size : Integer; 345 pragma Import (C, Maximum_Size, "__gnat_link_max"); 346 -- Maximum number of bytes to put in an invocation of the 347 -- Archive_Builder. 348 349 function Ensure_Directory (Path : String) return String; 350 -- Returns Path with an ending directory separator 351 352 function File_MD5 (Pathname : String) return Message_Digest; 353 -- Returns the file MD5 signature. Raises Name_Error if Pathname does not 354 -- exists. 355 356 -- Architecture 357 358 function Get_Target return String; 359 -- Returns the current target for the compilation 360 361 function Compute_Slave_Env 362 (Project : Project_Tree_Ref; Auto : Boolean) return String; 363 -- Compute a slave environment based on the command line parameter and 364 -- the project variables. We want the same slave environment for identical 365 -- build. Data is a string that must be taken into account in the returned 366 -- value. 367 368 function Get_Slaves_Hosts 369 (Project_Tree : Project_Tree_Ref; 370 Arg : String) return String; 371 -- Given the actual argument "--distributed[=...]" return the coma 372 -- separated list of slave hosts. This routine handle the GPR_SLAVE and 373 -- GPR_SLAVES_FILE environment variables. 374 375 function UTC_Time return Stamps.Time_Stamp_Type; 376 -- Returns the UTC time 377 378 function Check_Diff 379 (Ts1, Ts2 : Stamps.Time_Stamp_Type; 380 Max_Drift : Duration := 5.0) return Boolean; 381 -- Check two time stamps, returns True if both time are in a range of 382 -- Max_Drift seconds maximum. 383 384 function To_Time_Stamp (Time : Calendar.Time) return Stamps.Time_Stamp_Type; 385 -- Returns Time as a time stamp type 386 387 -- Compiler and package substitutions 388 389 -- The following are used to support the --compiler-subst and 390 -- --compiler-pkg-subst switches, which are used by tools such as gnatpp to 391 -- have gprbuild drive gnatpp, thus calling gnatpp only on files that need 392 -- it. 393 -- 394 -- gnatpp will pass --compiler-subst=ada,gnatpp to tell gprbuild to run 395 -- gnatpp instead of gcc. It will also pass 396 -- --compiler-pkg-subst=pretty_printer to tell gprbuild to get switches 397 -- from "package Pretty_Printer" instead of from "package Compiler". 398 399 procedure Set_Default_Verbosity; 400 -- Set the default verbosity from environment variable GPR_VERBOSITY. 401 -- The values that are taken into account, case-insensitive, are: 402 -- "quiet", "default", "verbose", "verbose_high", "verbose_medium" and 403 -- "verbose_low". 404 405 Compiler_Subst_Option : constant String := "--compiler-subst="; 406 Compiler_Pkg_Subst_Option : constant String := "--compiler-pkg-subst="; 407 408 package Compiler_Subst_HTable is new GNAT.HTable.Simple_HTable 409 (Header_Num => GPR.Header_Num, 410 Element => Name_Id, 411 No_Element => No_Name, 412 Key => Name_Id, 413 Hash => GPR.Hash, 414 Equal => "="); 415 -- A hash table to get the compiler to substitute from the from the 416 -- language name. For example, if the command line option 417 -- "--compiler-subst=ada,gnatpp" was given, then this mapping will include 418 -- the key-->value pair "ada" --> "gnatpp". This causes gprbuild to call 419 -- gnatpp instead of gcc. 420 421 Compiler_Pkg_Subst : Name_Id := No_Name; 422 -- A package name to be used when invoking the compiler, in addition to 423 -- "package Compiler". Normally, this is No_Name, indicating no additional 424 -- package, but it can be set by the --compiler-pkg-subst option. For 425 -- example, if --compiler-pkg-subst=pretty_printer was given, then this 426 -- will be "pretty_printer", and gnatpp will be invoked with switches from 427 -- "package Pretty_Printer", and -inner-cargs followed by switches from 428 -- "package Compiler". 429 430 package Project_Output is 431 -- Support for Gprname 432 433 Output_FD : File_Descriptor; 434 -- To save the project file and its naming project file 435 436 procedure Write_Eol; 437 -- Output an empty line 438 439 procedure Write_A_Char (C : Character); 440 -- Write one character to Output_FD 441 442 procedure Write_A_String (S : String); 443 -- Write a String to Output_FD 444 end Project_Output; 445 446end Gpr_Util; 447