------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- M A K E _ U T I L -- -- -- -- S p e c -- -- -- -- Copyright (C) 2004-2018, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING3. If not, go to -- -- http://www.gnu.org/licenses for a complete copy of the license. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ -- This package contains various subprograms used by the builders, in -- particular those subprograms related to build queue management. with Namet; use Namet; with Opt; with Osint; with Types; use Types; with GNAT.OS_Lib; use GNAT.OS_Lib; package Make_Util is type Fail_Proc is access procedure (S : String); -- Pointer to procedure which outputs a failure message -- Root_Environment : Prj.Tree.Environment; -- The environment coming from environment variables and command line -- switches. When we do not have an aggregate project, this is used for -- parsing the project tree. When we have an aggregate project, this is -- used to parse the aggregate project; the latter then generates another -- environment (with additional external values and project path) to parse -- the aggregated projects. -- Default_Config_Name : constant String := "default.cgpr"; -- Name of the configuration file used by gprbuild and generated by -- gprconfig by default. On_Windows : constant Boolean := Directory_Separator = '\'; -- True when on Windows Source_Info_Option : constant String := "--source-info="; -- Switch to indicate the source info file Subdirs_Option : constant String := "--subdirs="; -- Switch used to indicate that the real directories (object, exec, -- library, ...) are subdirectories of those in the project file. Relocate_Build_Tree_Option : constant String := "--relocate-build-tree"; -- Switch to build out-of-tree. In this context the object, exec and -- library directories are relocated to the current working directory -- or the directory specified as parameter to this option. Unchecked_Shared_Lib_Imports : constant String := "--unchecked-shared-lib-imports"; -- Command line switch to allow shared library projects to import projects -- that are not shared library projects. Single_Compile_Per_Obj_Dir_Switch : constant String := "--single-compile-per-obj-dir"; -- Switch to forbid simultaneous compilations for the same object directory -- when project files are used. Create_Map_File_Switch : constant String := "--create-map-file"; -- Switch to create a map file when an executable is linked No_Exit_Message_Option : constant String := "--no-exit-message"; -- Switch to suppress exit error message when there are compilation -- failures. This is useful when a tool, such as gnatprove, silently calls -- the builder and does not want to pollute its output with error messages -- coming from the builder. This is an internal switch. Keep_Temp_Files_Option : constant String := "--keep-temp-files"; -- Switch to suppress deletion of temp files created by the builder. -- Note that debug switch -gnatdn also has this effect. procedure Add (Option : String_Access; To : in out String_List_Access; Last : in out Natural); procedure Add (Option : String; To : in out String_List_Access; Last : in out Natural); -- Add a string to a list of strings function Create_Name (Name : String) return File_Name_Type; function Create_Name (Name : String) return Name_Id; function Create_Name (Name : String) return Path_Name_Type; -- Get an id for a name function Base_Name_Index_For (Main : String; Main_Index : Int; Index_Separator : Character) return File_Name_Type; -- Returns the base name of Main, without the extension, followed by the -- Index_Separator followed by the Main_Index if it is non-zero. function Executable_Prefix_Path return String; -- Return the absolute path parent directory of the directory where the -- current executable resides, if its directory is named "bin", otherwise -- return an empty string. When a directory is returned, it is guaranteed -- to end with a directory separator. procedure Inform (N : Name_Id := No_Name; Msg : String); procedure Inform (N : File_Name_Type; Msg : String); -- Prints out the program name followed by a colon, N and S procedure Ensure_Absolute_Path (Switch : in out String_Access; Parent : String; Do_Fail : Fail_Proc; For_Gnatbind : Boolean := False; Including_Non_Switch : Boolean := True; Including_RTS : Boolean := False); -- Do nothing if Switch is an absolute path switch. If relative, fail if -- Parent is the empty string, otherwise prepend the path with Parent. This -- subprogram is only used when using project files. If For_Gnatbind is -- True, consider gnatbind specific syntax for -L (not a path, left -- unchanged) and -A (path is optional, preceded with "=" if present). -- If Including_RTS is True, process also switches --RTS=. Do_Fail is -- called in case of error. Using Osint.Fail might be appropriate. type Name_Ids is array (Positive range <>) of Name_Id; No_Names : constant Name_Ids := (1 .. 0 => No_Name); -- Name_Ids is used for list of language names in procedure Get_Directories -- below. function Path_Or_File_Name (Path : Path_Name_Type) return String; -- Returns a file name if -df is used, otherwise return a path name function Unit_Index_Of (ALI_File : File_Name_Type) return Int; -- Find the index of a unit in a source file. Return zero if the file is -- not a multi-unit source file. procedure Verbose_Msg (N1 : Name_Id; S1 : String; N2 : Name_Id := No_Name; S2 : String := ""; Prefix : String := " -> "; Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low); procedure Verbose_Msg (N1 : File_Name_Type; S1 : String; N2 : File_Name_Type := No_File; S2 : String := ""; Prefix : String := " -> "; Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low); -- If the verbose flag (Verbose_Mode) is set and the verbosity level is at -- least equal to Minimum_Verbosity, then print Prefix to standard output -- followed by N1 and S1. If N2 /= No_Name then N2 is printed after S1. S2 -- is printed last. Both N1 and N2 are printed in quotation marks. The two -- forms differ only in taking Name_Id or File_Name_Type arguments. Max_Header_Num : constant := 6150; type Header_Num is range 0 .. Max_Header_Num; -- Size for hash table below. The upper bound is an arbitrary value, the -- value here was chosen after testing to determine a good compromise -- between speed of access and memory usage. function Hash (Name : Name_Id) return Header_Num; function Hash (Name : File_Name_Type) return Header_Num; function Hash (Name : Path_Name_Type) return Header_Num; ------------------------- -- Program termination -- ------------------------- procedure Fail_Program (S : String; Flush_Messages : Boolean := True); pragma No_Return (Fail_Program); -- Terminate program with a message and a fatal status code procedure Finish_Program (Exit_Code : Osint.Exit_Code_Type := Osint.E_Success; S : String := ""); pragma No_Return (Finish_Program); -- Terminate program, with or without a message, setting the status code -- according to Fatal. This properly removes all temporary files. ----------- -- Mains -- ----------- -- Package Mains is used to store the mains specified on the command line -- and to retrieve them when a project file is used, to verify that the -- files exist and that they belong to a project file. -- Mains are stored in a table. An index is used to retrieve the mains -- from the table. type Main_Info is record File : File_Name_Type; -- Always canonical casing Index : Int := 0; end record; No_Main_Info : constant Main_Info := (No_File, 0); package Mains is procedure Add_Main (Name : String; Index : Int := 0); -- Add one main to the table. This is in general used to add the main -- files specified on the command line. Index is used for multi-unit -- source files, and indicates which unit in the source is concerned. procedure Delete; -- Empty the table procedure Reset; -- Reset the cursor to the beginning of the table procedure Set_Multi_Unit_Index (Index : Int := 0); -- If a single main file was defined, this subprogram indicates which -- unit inside it is the main (case of a multi-unit source files). -- Errors are raised if zero or more than one main file was defined, -- and Index is non-zaero. This subprogram is used for the handling -- of the command line switch. function Next_Main return String; function Next_Main return Main_Info; -- Moves the cursor forward and returns the new current entry. Returns -- No_Main_Info there are no more mains in the table. function Number_Of_Mains return Natural; -- Returns the number of main. end Mains; ----------- -- Queue -- ----------- package Queue is -- The queue of sources to be checked for compilation. There can be a -- single such queue per application. type Source_Info is record File : File_Name_Type := No_File; Unit : Unit_Name_Type := No_Unit_Name; Index : Int := 0; end record; -- Information about files stored in the queue. No_Source_Info : constant Source_Info := (No_File, No_Unit_Name, 0); procedure Initialize (Force : Boolean := False); -- Initialize the queue procedure Remove_Marks; -- Remove all marks set for the files. This means that the files will be -- handed to the compiler if they are added to the queue, and is mostly -- useful when recompiling several executables as the switches may be -- different and -s may be in use. function Is_Empty return Boolean; -- Returns True if the queue is empty procedure Insert (Source : Source_Info); function Insert (Source : Source_Info) return Boolean; -- Insert source in the queue. The second version returns False if the -- Source was already marked in the queue. procedure Extract (Found : out Boolean; Source : out Source_Info); -- Get the first source that can be compiled from the queue. If no -- source may be compiled, sets Found to False. In this case, the value -- for Source is undefined. function Size return Natural; -- Return the total size of the queue, including the sources already -- extracted. function Processed return Natural; -- Return the number of source in the queue that have aready been -- processed. function Element (Rank : Positive) return File_Name_Type; -- Get the file name for element of index Rank in the queue end Queue; end Make_Util;