-- queue management.
with ALI;
-with GNAT.OS_Lib; use GNAT.OS_Lib;
-with Namet; use Namet;
+with Namet; use Namet;
with Opt;
-with Prj; use Prj;
+with Osint;
+with Prj; use Prj;
with Prj.Tree;
-with Types; use Types;
+with Types; use Types;
+
+with GNAT.OS_Lib; use GNAT.OS_Lib;
package Makeutl is
type Fail_Proc is access procedure (S : String);
+ -- Pointer to procedure which outputs a failure message
+
+ On_Windows : constant Boolean := Directory_Separator = '\';
+ -- True when on Windows
Source_Info_Option : constant String := "--source-info=";
-- Switch to indicate the source info file
-- source files are still associated with the same units). Return True
-- if everything is still valid.
+ function Is_Subunit (Source : Source_Id) return Boolean;
+ -- Return True if source is a subunit
+
+ procedure Initialize_Source_Record (Source : Source_Id);
+ -- Get information either about the source file, or the object and
+ -- dependency file, as well as their timestamps.
+
function Is_External_Assignment
(Env : Prj.Tree.Environment;
Argv : String) return Boolean;
Including_L_Switch : Boolean := True;
Including_Non_Switch : Boolean := True;
Including_RTS : Boolean := False);
- -- Test if Switch is a relative search path switch. If it is, fail if
- -- Parent is the empty string, otherwise prepend the path with Parent.
- -- This subprogram is only called when using project files. For gnatbind
- -- switches, Including_L_Switch is False, because the argument of the -L
- -- switch is not a path. If Including_RTS is True, process also switches
- -- --RTS=.
- -- Do_Fail is called in case of error. Using Osing.Fail might be
+ -- Test if Switch is a relative search path switch. If so, fail if Parent
+ -- is the empty string, otherwise prepend the path with Parent. This
+ -- subprogram is only used when using project files. For gnatbind switches,
+ -- Including_L_Switch is False, because the argument of the -L switch is
+ -- not a path. If Including_RTS is True, process also switches --RTS=.
+ -- Do_Fail is called in case of error. Using Osint.Fail might be
-- appropriate.
function Path_Or_File_Name (Path : Path_Name_Type) return String;
-- Returns a file name if -df is used, otherwise return a path name
+ -------------------------
+ -- Program termination --
+ -------------------------
+
+ procedure Fail_Program
+ (Project_Tree : Project_Tree_Ref;
+ S : String;
+ Flush_Messages : Boolean := True);
+ -- Terminate program with a message and a fatal status code
+
+ procedure Finish_Program
+ (Project_Tree : Project_Tree_Ref;
+ Exit_Code : Osint.Exit_Code_Type := Osint.E_Success;
+ S : String := "");
+ -- Terminate program, with or without a message, setting the status code
+ -- according to Fatal. This properly removes all temporary files.
+
+ -----------------------
+ -- Project_Tree data --
+ -----------------------
+
+ -- The following types are specific to builders, and associated with each
+ -- of the loaded project trees.
+
+ type Binding_Data_Record;
+ type Binding_Data is access Binding_Data_Record;
+ type Binding_Data_Record is record
+ Language : Language_Ptr;
+ Language_Name : Name_Id;
+ Binder_Driver_Name : File_Name_Type;
+ Binder_Driver_Path : String_Access;
+ Binder_Prefix : Name_Id;
+ Next : Binding_Data;
+ end record;
+ -- Data for a language that have a binder driver
+
+ type Builder_Project_Tree_Data is new Project_Tree_Appdata with record
+ Binding : Binding_Data;
+
+ There_Are_Binder_Drivers : Boolean := False;
+ -- True when there is a binder driver. Set by Get_Configuration when
+ -- an attribute Language_Processing'Binder_Driver is declared.
+ -- Reset to False if there are no sources of the languages with binder
+ -- drivers.
+
+ Number_Of_Mains : Natural := 0;
+ -- Number of main units in this project tree
+
+ Closure_Needed : Boolean := False;
+ -- If True, we need to add the closure of the file we just compiled to
+ -- the queue. If False, it is assumed that all files are already on the
+ -- queue so we do not waste time computing the closure.
+
+ Need_Compilation : Boolean := True;
+ Need_Binding : Boolean := True;
+ Need_Linking : Boolean := True;
+ -- Which of the compilation phases are needed for this project tree.
+ end record;
+ type Builder_Data_Access is access all Builder_Project_Tree_Data;
+
+ procedure Free (Data : in out Builder_Project_Tree_Data);
+ -- Free all memory allocated for Data
+
+ function Builder_Data (Tree : Project_Tree_Ref) return Builder_Data_Access;
+ -- Return (allocate if needed) tree-specific data
+
+ procedure Compute_Compilation_Phases
+ (Tree : Project_Tree_Ref;
+ Root_Project : Project_Id;
+ Option_Unique_Compile : Boolean := False; -- Was "-u" specified ?
+ Option_Compile_Only : Boolean := False; -- Was "-c" specified ?
+ Option_Bind_Only : Boolean := False;
+ Option_Link_Only : Boolean := False);
+ -- Compute which compilation phases will be needed for Tree. This also does
+ -- the computation for aggregated trees. This also check whether we'll need
+ -- to check the closure of the files we have just compiled to add them to
+ -- the queue.
+
-----------
-- Mains --
-----------
-- Mains are stored in a table. An index is used to retrieve the mains
-- from the table.
- package Mains is
+ type Main_Info is record
+ File : File_Name_Type; -- Always canonical casing
+ Index : Int := 0;
+ Location : Source_Ptr := No_Location;
- procedure Add_Main (Name : String);
- -- Add one main to the table
+ Source : Prj.Source_Id := No_Source;
+ Project : Project_Id;
+ Tree : Project_Tree_Ref;
+ end record;
- procedure Set_Index (Index : Int);
+ No_Main_Info : constant Main_Info :=
+ (No_File, 0, No_Location, No_Source, No_Project, null);
- procedure Set_Location (Location : Source_Ptr);
- -- Set the location of the last main added. By default, the location is
- -- No_Location.
+ package Mains is
+ procedure Add_Main
+ (Name : String;
+ Index : Int := 0;
+ Location : Source_Ptr := No_Location;
+ Project : Project_Id := No_Project;
+ Tree : Project_Tree_Ref := null);
+ -- 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.
+ -- Location is the location within the project file (if a project file
+ -- is used). Project and Tree indicate to which project the main should
+ -- belong. In particular, for aggregate projects, this isn't necessarily
+ -- the main project tree. These can be set to No_Project and null when
+ -- not using projects.
procedure Delete;
-- Empty the table
procedure Reset;
- -- Reset the index to the beginning of the table
-
- function Next_Main return String;
- -- Increase the index and return the next main. If table is exhausted,
- -- return an empty string.
-
- function Get_Index return Int;
+ -- Reset the cursor to the beginning of the table
- function Get_Location return Source_Ptr;
- -- Get the location of the current main
+ procedure Set_Multi_Unit_Index
+ (Project_Tree : Project_Tree_Ref := null;
+ 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.
- procedure Update_Main (Name : String);
- -- Update the file name of the current main
-
- function Number_Of_Mains return Natural;
- -- Returns the number of mains added with Add_Main since the last call
- -- to Delete.
+ 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 (Tree : Project_Tree_Ref) return Natural;
+ -- Returns the number of mains in this project tree (if Tree is null, it
+ -- returns the total number of project trees)
+
+ procedure Fill_From_Project
+ (Root_Project : Project_Id;
+ Project_Tree : Project_Tree_Ref);
+ -- If no main was already added (presumably from the command line), add
+ -- the main units from root_project (or in the case of an aggregate
+ -- project from all the aggregated projects).
+
+ procedure Complete_Mains
+ (Flags : Processing_Flags;
+ Root_Project : Project_Id;
+ Project_Tree : Project_Tree_Ref);
+ -- If some main units were already added from the command line, check
+ -- that they all belong to the root project, and that they are full
+ -- paths rather than (partial) base names (e.g. no body suffix was
+ -- specified).
end Mains;
type Source_Info_Format is (Format_Gprbuild, Format_Gnatmake);
package Queue is
- -- The queue of sources to be checked for compilation.
- -- There can be a single such queue per application.
+
+ -- The queue of sources to be checked for compilation. There can be a
+ -- single such queue per application.
type Source_Info (Format : Source_Info_Format := Format_Gprbuild) is
record
case Format is
- when Format_Gprbuild =>
- Id : Source_Id := null;
-
- when Format_Gnatmake =>
- File : File_Name_Type := No_File;
- Unit : Unit_Name_Type := No_Unit_Name;
- Index : Int := 0;
- Project : Project_Id := No_Project;
+ when Format_Gprbuild =>
+ Tree : Project_Tree_Ref := null;
+ Id : Source_Id := null;
+
+ when Format_Gnatmake =>
+ File : File_Name_Type := No_File;
+ Unit : Unit_Name_Type := No_Unit_Name;
+ Index : Int := 0;
+ Project : Project_Id := No_Project;
end case;
end record;
-- Information about files stored in the queue. The exact information
-- depends on the builder, and in particular whether it only supports
-- project-based files (in which case we have a full Source_Id record).
+ No_Source_Info : constant Source_Info := (Format_Gprbuild, null, null);
+
procedure Initialize
(Queue_Per_Obj_Dir : Boolean;
Force : Boolean := False);
-- Returns True if the queue is empty
function Is_Virtually_Empty return Boolean;
- -- Returns True if the queue is empty or if all object directories are
- -- busy.
-
- 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.
+ -- Returns True if queue is empty or if all object directories are busy
+
+ procedure Insert (Source : Source_Info; With_Roots : Boolean := False);
+ function Insert
+ (Source : Source_Info; With_Roots : Boolean := False) return Boolean;
+ -- Insert source in the queue. The second version returns False if the
+ -- Source was already marked in the queue. If With_Roots is True and the
+ -- source is in Format_Gprbuild mode (ie with a project), this procedure
+ -- also includes the "Roots" for this main, ie all the other files that
+ -- must be included in the library or binary (in particular to combine
+ -- Ada and C files connected through pragma Export/Import). When the
+ -- roots are computed, they are also stored in the corresponding
+ -- Source_Id for later reuse by the binder.
+
+ procedure Insert_Project_Sources
+ (Project : Project_Id;
+ Project_Tree : Project_Tree_Ref;
+ All_Projects : Boolean;
+ Unique_Compile : Boolean);
+ -- Insert all the compilable sources of the project in the queue. If
+ -- All_Project is true, then all sources from imported projects are also
+ -- inserted. Unique_Compile should be true if "-u" was specified on the
+ -- command line: if True and some files were given on the command line),
+ -- only those files will be compiled (so Insert_Project_Sources will do
+ -- nothing). If True and no file was specified on the command line, all
+ -- files of the project(s) will be compiled. This procedure also
+ -- processed aggregated projects.
+
+ procedure Insert_Withed_Sources_For
+ (The_ALI : ALI.ALI_Id;
+ Project_Tree : Project_Tree_Ref;
+ Excluding_Shared_SALs : Boolean := False);
+ -- Insert in the queue those sources withed by The_ALI, if there are not
+ -- already in the queue and Only_Interfaces is False or they are part of
+ -- the interfaces of their project.
procedure Extract
(Found : out Boolean;
projects / thirdparty / gcc.git / blobdiff