-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, 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- --
with Snames; use Snames;
with Switch; use Switch;
with Switch.M; use Switch.M;
-with Targparm;
+with Targparm; use Targparm;
+with Table;
with Tempdir;
+with Types; use Types;
with Ada.Exceptions; use Ada.Exceptions;
with Ada.Command_Line; use Ada.Command_Line;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
-with GNAT.Case_Util; use GNAT.Case_Util;
+with System.Case_Util; use System.Case_Util;
+with System.OS_Lib; use System.OS_Lib;
with System.HTable;
package body Make is
procedure Insert_Q
(Source_File : File_Name_Type;
- Source_Unit : Unit_Name_Type := No_Name;
+ Source_Unit : Unit_Name_Type := No_Unit_Name;
Index : Int := 0);
-- Inserts Source_File at the end of Q. Provide Source_Unit when possible
-- for external use (gnatdist). Provide index for multi-unit sources.
package Q is new Table.Table (
Table_Component_Type => Q_Record,
- Table_Index_Type => Natural,
+ Table_Index_Type => Integer,
Table_Low_Bound => 0,
Table_Initial => 4000,
Table_Increment => 100,
Table_Name => "Make.Q");
-- This is the actual Q
+ -- The 3 following packages are used to store gcc, gnatbind and gnatlink
+ -- switches found in the project files.
+
+ package Gcc_Switches is new Table.Table (
+ Table_Component_Type => String_Access,
+ Table_Index_Type => Integer,
+ Table_Low_Bound => 1,
+ Table_Initial => 20,
+ Table_Increment => 100,
+ Table_Name => "Make.Gcc_Switches");
+
+ package Binder_Switches is new Table.Table (
+ Table_Component_Type => String_Access,
+ Table_Index_Type => Integer,
+ Table_Low_Bound => 1,
+ Table_Initial => 20,
+ Table_Increment => 100,
+ Table_Name => "Make.Binder_Switches");
+
+ package Linker_Switches is new Table.Table (
+ Table_Component_Type => String_Access,
+ Table_Index_Type => Integer,
+ Table_Low_Bound => 1,
+ Table_Initial => 20,
+ Table_Increment => 100,
+ Table_Name => "Make.Linker_Switches");
+
-- The following instantiations and variables are necessary to save what
-- is found on the command line, in case there is a project file specified.
Main_Project : Prj.Project_Id := No_Project;
-- The project id of the main project file, if any
- Project_Object_Directory : Project_Id := No_Project;
+ Project_Of_Current_Object_Directory : Project_Id := No_Project;
-- The object directory of the project for the last compilation. Avoid
-- calling Change_Dir if the current working directory is already this
-- directory
type Header_Num is range 1 .. Max_Header;
-- Header_Num for the hash table Obsoleted below
- function Hash (F : Name_Id) return Header_Num;
+ function Hash (F : File_Name_Type) return Header_Num;
-- Hash function for the hash table Obsoleted below
package Obsoleted is new System.HTable.Simple_HTable
(Header_Num => Header_Num,
Element => Boolean,
No_Element => False,
- Key => Name_Id,
+ Key => File_Name_Type,
Hash => Hash,
Equal => "=");
-- A hash table to keep all files that have been compiled, to detect
-- if an executable is up to date or not.
- procedure Enter_Into_Obsoleted (F : Name_Id);
+ procedure Enter_Into_Obsoleted (F : File_Name_Type);
-- Enter a file name, without directory information, into the hash table
-- Obsoleted.
- function Is_In_Obsoleted (F : Name_Id) return Boolean;
+ function Is_In_Obsoleted (F : File_Name_Type) return Boolean;
-- Check if a file name, without directory information, has already been
-- entered into the hash table Obsoleted.
type Dependency is record
- This : Name_Id;
- Depends_On : Name_Id;
+ This : File_Name_Type;
+ Depends_On : File_Name_Type;
end record;
-- Components of table Dependencies below
Table_Increment => 100,
Table_Name => "Make.Dependencies");
-- A table to keep dependencies, to be able to decide if an executable
- -- is obsolete.
-
- procedure Add_Dependency (S : Name_Id; On : Name_Id);
- -- Add one entry in table Dependencies
+ -- is obsolete. More explanation needed ???
----------------------------
-- Arguments and Switches --
-- no additional ALI files should be scanned between the two calls (i.e.
-- between the call to Compile_Sources and List_Depend.)
- procedure Inform (N : Name_Id := No_Name; Msg : String);
- -- Prints out the program name followed by a colon, N and S
+ procedure Inform (N : Name_Id; Msg : String);
+ procedure Inform (N : File_Name_Type; Msg : String);
+ procedure Inform (Msg : String);
+ -- Prints out the program name followed by a colon, N (if present) and Msg
procedure List_Bad_Compilations;
-- Prints out the list of all files for which the compilation failed
S2 : String := "";
Prefix : String := " -> ";
Minimum_Verbosity : 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 : 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
-- Set Usage_Needed to False.
procedure Debug_Msg (S : String; N : Name_Id);
+ procedure Debug_Msg (S : String; N : File_Name_Type);
+ procedure Debug_Msg (S : String; N : Unit_Name_Type);
-- If Debug.Debug_Flag_W is set outputs string S followed by name N
procedure Recursive_Compute_Depth
-- Check what steps (Compile, Bind, Link) must be executed.
-- Set the step flags accordingly.
- function In_Ada_Lib_Dir (File : File_Name_Type) return Boolean;
+ function In_Ada_Lib_Dir (File : File_Name_Type) return Boolean;
-- Get directory prefix of this file and get lib mark stored in name
-- table for this directory. Then check if an Ada lib mark has been set.
-- compiler.
function Switches_Of
- (Source_File : Name_Id;
+ (Source_File : File_Name_Type;
Source_File_Name : String;
Source_Index : Int;
Naming : Naming_Data;
-- Given by the command line. Will be used, if non null
Gcc_Path : String_Access :=
- GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all);
+ System.OS_Lib.Locate_Exec_On_Path (Gcc.all);
Gnatbind_Path : String_Access :=
- GNAT.OS_Lib.Locate_Exec_On_Path (Gnatbind.all);
+ System.OS_Lib.Locate_Exec_On_Path (Gnatbind.all);
Gnatlink_Path : String_Access :=
- GNAT.OS_Lib.Locate_Exec_On_Path (Gnatlink.all);
+ System.OS_Lib.Locate_Exec_On_Path (Gnatlink.all);
-- Path for compiler, binder, linker programs, defaulted now for gnatdist.
-- Changed later if overridden on command line.
-- Displays Program followed by the arguments in Args if variable
-- Display_Executed_Programs is set. The lower bound of Args must be 1.
+ procedure Report_Compilation_Failed;
+ -- Delete all temporary files and fail graciously
+
-----------------
-- Mapping files
-----------------
- type Temp_File_Names is
- array (Project_Id range <>, Positive range <>) of Name_Id;
+ type Temp_Path_Names is
+ array (Project_Id range <>, Positive range <>) of Path_Name_Type;
- type Temp_Files_Ptr is access Temp_File_Names;
+ type Temp_Path_Ptr is access Temp_Path_Names;
type Indices is array (Project_Id range <>) of Natural;
type Free_Indices_Ptr is access Free_File_Indices;
- The_Mapping_File_Names : Temp_Files_Ptr;
+ The_Mapping_File_Names : Temp_Path_Ptr;
-- For each project, the name ids of the temporary mapping files used
Last_Mapping_File_Names : Indices_Ptr;
procedure Delete_All_Temp_Files;
-- Delete all temp files (config files, mapping files, path files)
+ -------------------------------------------------
+ -- Subprogram declarations moved from the spec --
+ -------------------------------------------------
+
+ procedure Bind (ALI_File : File_Name_Type; Args : Argument_List);
+ -- Binds ALI_File. Args are the arguments to pass to the binder.
+ -- Args must have a lower bound of 1.
+
+ procedure Display_Commands (Display : Boolean := True);
+ -- The default behavior of Make commands (Compile_Sources, Bind, Link)
+ -- is to display them on stderr. This behavior can be changed repeatedly
+ -- by invoking this procedure.
+
+ -- If a compilation, bind or link failed one of the following 3 exceptions
+ -- is raised. These need to be handled by the calling routines.
+
+ procedure Compile_Sources
+ (Main_Source : File_Name_Type;
+ Args : Argument_List;
+ First_Compiled_File : out File_Name_Type;
+ Most_Recent_Obj_File : out File_Name_Type;
+ Most_Recent_Obj_Stamp : out Time_Stamp_Type;
+ Main_Unit : out Boolean;
+ Compilation_Failures : out Natural;
+ Main_Index : Int := 0;
+ Check_Readonly_Files : Boolean := False;
+ Do_Not_Execute : Boolean := False;
+ Force_Compilations : Boolean := False;
+ Keep_Going : Boolean := False;
+ In_Place_Mode : Boolean := False;
+ Initialize_ALI_Data : Boolean := True;
+ Max_Process : Positive := 1);
+ -- Compile_Sources will recursively compile all the sources needed by
+ -- Main_Source. Before calling this routine make sure Namet has been
+ -- initialized. This routine can be called repeatedly with different
+ -- Main_Source file as long as all the source (-I flags), library
+ -- (-B flags) and ada library (-A flags) search paths between calls are
+ -- *exactly* the same. The default directory must also be the same.
+ --
+ -- Args contains the arguments to use during the compilations.
+ -- The lower bound of Args must be 1.
+ --
+ -- First_Compiled_File is set to the name of the first file that is
+ -- compiled or that needs to be compiled. This is set to No_Name if no
+ -- compilations were needed.
+ --
+ -- Most_Recent_Obj_File is set to the full name of the most recent
+ -- object file found when no compilations are needed, that is when
+ -- First_Compiled_File is set to No_Name. When First_Compiled_File
+ -- is set then Most_Recent_Obj_File is set to No_Name.
+ --
+ -- Most_Recent_Obj_Stamp is the time stamp of Most_Recent_Obj_File.
+ --
+ -- Main_Unit is set to True if Main_Source can be a main unit.
+ -- If Do_Not_Execute is False and First_Compiled_File /= No_Name
+ -- the value of Main_Unit is always False.
+ -- Is this used any more??? It is certainly not used by gnatmake???
+ --
+ -- Compilation_Failures is a count of compilation failures. This count
+ -- is used to extract compilation failure reports with Extract_Failure.
+ --
+ -- Main_Index, when not zero, is the index of the main unit in source
+ -- file Main_Source which is a multi-unit source.
+ -- Zero indicates that Main_Source is a single unit source file.
+ --
+ -- Check_Readonly_Files set it to True to compile source files
+ -- which library files are read-only. When compiling GNAT predefined
+ -- files the "-gnatg" flag is used.
+ --
+ -- Do_Not_Execute set it to True to find out the first source that
+ -- needs to be recompiled, but without recompiling it. This file is
+ -- saved in First_Compiled_File.
+ --
+ -- Force_Compilations forces all compilations no matter what but
+ -- recompiles read-only files only if Check_Readonly_Files
+ -- is set.
+ --
+ -- Keep_Going when True keep compiling even in the presence of
+ -- compilation errors.
+ --
+ -- In_Place_Mode when True save library/object files in their object
+ -- directory if they already exist; otherwise, in the source directory.
+ --
+ -- Initialize_ALI_Data set it to True when you want to initialize ALI
+ -- data-structures. This is what you should do most of the time.
+ -- (especially the first time around when you call this routine).
+ -- This parameter is set to False to preserve previously recorded
+ -- ALI file data.
+ --
+ -- Max_Process is the maximum number of processes that should be spawned
+ -- to carry out compilations.
+ --
+ -- Flags in Package Opt Affecting Compile_Sources
+ -- -----------------------------------------------
+ --
+ -- Check_Object_Consistency set it to False to omit all consistency
+ -- checks between an .ali file and its corresponding object file.
+ -- When this flag is set to true, every time an .ali is read,
+ -- package Osint checks that the corresponding object file
+ -- exists and is more recent than the .ali.
+ --
+ -- Use of Name Table Info
+ -- ----------------------
+ --
+ -- All file names manipulated by Compile_Sources are entered into the
+ -- Names table. The Byte field of a source file is used to mark it.
+ --
+ -- Calling Compile_Sources Several Times
+ -- -------------------------------------
+ --
+ -- Upon return from Compile_Sources all the ALI data structures are left
+ -- intact for further browsing. HOWEVER upon entry to this routine ALI
+ -- data structures are re-initialized if parameter Initialize_ALI_Data
+ -- above is set to true. Typically this is what you want the first time
+ -- you call Compile_Sources. You should not load an ali file, call this
+ -- routine with flag Initialize_ALI_Data set to True and then expect
+ -- that ALI information to be around after the call. Note that the first
+ -- time you call Compile_Sources you better set Initialize_ALI_Data to
+ -- True unless you have called Initialize_ALI yourself.
+ --
+ -- Compile_Sources ALGORITHM : Compile_Sources (Main_Source)
+ -- -------------------------
+ --
+ -- 1. Insert Main_Source in a Queue (Q) and mark it.
+ --
+ -- 2. Let unit.adb be the file at the head of the Q. If unit.adb is
+ -- missing but its corresponding ali file is in an Ada library directory
+ -- (see below) then, remove unit.adb from the Q and goto step 4.
+ -- Otherwise, look at the files under the D (dependency) section of
+ -- unit.ali. If unit.ali does not exist or some of the time stamps do
+ -- not match, (re)compile unit.adb.
+ --
+ -- An Ada library directory is a directory containing Ada specs, ali
+ -- and object files but no source files for the bodies. An Ada library
+ -- directory is communicated to gnatmake by means of some switch so that
+ -- gnatmake can skip the sources whole ali are in that directory.
+ -- There are two reasons for skipping the sources in this case. Firstly,
+ -- Ada libraries typically come without full sources but binding and
+ -- linking against those libraries is still possible. Secondly, it would
+ -- be very wasteful for gnatmake to systematically check the consistency
+ -- of every external Ada library used in a program. The binder is
+ -- already in charge of catching any potential inconsistencies.
+ --
+ -- 3. Look into the W section of unit.ali and insert into the Q all
+ -- unmarked source files. Mark all files newly inserted in the Q.
+ -- Specifically, assuming that the W section looks like
+ --
+ -- W types%s types.adb types.ali
+ -- W unchecked_deallocation%s
+ -- W xref_tab%s xref_tab.adb xref_tab.ali
+ --
+ -- Then xref_tab.adb and types.adb are inserted in the Q if they are not
+ -- already marked.
+ -- Note that there is no file listed under W unchecked_deallocation%s
+ -- so no generic body should ever be explicitly compiled (unless the
+ -- Main_Source at the start was a generic body).
+ --
+ -- 4. Repeat steps 2 and 3 above until the Q is empty
+ --
+ -- Note that the above algorithm works because the units withed in
+ -- subunits are transitively included in the W section (with section) of
+ -- the main unit. Likewise the withed units in a generic body needed
+ -- during a compilation are also transitively included in the W section
+ -- of the originally compiled file.
+
+ procedure Initialize;
+ -- Performs default and package initialization. Therefore,
+ -- Compile_Sources can be called by an external unit.
+
+ procedure Link
+ (ALI_File : File_Name_Type;
+ Args : Argument_List;
+ Success : out Boolean);
+ -- Links ALI_File. Args are the arguments to pass to the linker.
+ -- Args must have a lower bound of 1. Success indicates if the link
+ -- succeeded or not.
+
+ procedure Scan_Make_Arg (Argv : String; And_Save : Boolean);
+ -- Scan make arguments. Argv is a single argument to be processed
+
-------------------
-- Add_Arguments --
-------------------
Last_Argument := Last_Argument + Args'Length;
end Add_Arguments;
- --------------------
- -- Add_Dependency --
- --------------------
-
- procedure Add_Dependency (S : Name_Id; On : Name_Id) is
- begin
- Dependencies.Increment_Last;
- Dependencies.Table (Dependencies.Last) := (S, On);
- end Add_Dependency;
-
----------------------------
-- Add_Library_Search_Dir --
----------------------------
is
begin
if On_Command_Line then
- Add_Lib_Search_Dir
- (Normalize_Pathname (Path));
+ Add_Lib_Search_Dir (Normalize_Pathname (Path));
else
Get_Name_String
- (Project_Tree.Projects.Table (Main_Project).Directory);
+ (Project_Tree.Projects.Table (Main_Project).Display_Directory);
Add_Lib_Search_Dir
- (Normalize_Pathname
- (Path, Name_Buffer (1 .. Name_Len)));
+ (Normalize_Pathname (Path, Name_Buffer (1 .. Name_Len)));
end if;
end Add_Library_Search_Dir;
is
begin
if On_Command_Line then
- Add_Src_Search_Dir
- (Normalize_Pathname (Path));
+ Add_Src_Search_Dir (Normalize_Pathname (Path));
else
Get_Name_String
- (Project_Tree.Projects.Table (Main_Project).Directory);
+ (Project_Tree.Projects.Table (Main_Project).Display_Directory);
Add_Src_Search_Dir
- (Normalize_Pathname
- (Path, Name_Buffer (1 .. Name_Len)));
+ (Normalize_Pathname (Path, Name_Buffer (1 .. Name_Len)));
end if;
end Add_Source_Search_Dir;
Switch_List := Switches.Values;
while Switch_List /= Nil_String loop
- Element :=
- Project_Tree.String_Elements.Table (Switch_List);
+ Element := Project_Tree.String_Elements.Table (Switch_List);
Get_Name_String (Element.Value);
if Name_Len > 0 then
Bind_Last := Bind_Last + 1;
Bind_Args (Bind_Last) := new String'(Name_Buffer (1 .. Name_Len));
- GNAT.OS_Lib.Normalize_Arguments (Bind_Args (Args'First .. Bind_Last));
+ System.OS_Lib.Normalize_Arguments (Bind_Args (Args'First .. Bind_Last));
Display (Gnatbind.all, Bind_Args (Args'First .. Bind_Last));
Make_Failed ("error, unable to locate ", Gnatbind.all);
end if;
- GNAT.OS_Lib.Spawn
+ System.OS_Lib.Spawn
(Gnatbind_Path.all, Bind_Args (Args'First .. Bind_Last), Success);
if not Success then
- raise Bind_Failed;
+ Make_Failed ("*** bind failed.");
end if;
end Bind;
--------------------------------
procedure Change_To_Object_Directory (Project : Project_Id) is
- Actual_Project : Project_Id;
+ Actual_Project : Project_Id;
+ Object_Directory : Path_Name_Type;
begin
-- For sources outside of any project, compilation occurs in the object
-- Nothing to do if the current working directory is already the correct
-- object directory.
- if Project_Object_Directory /= Actual_Project then
- Project_Object_Directory := Actual_Project;
+ if Project_Of_Current_Object_Directory /= Actual_Project then
+ Project_Of_Current_Object_Directory := Actual_Project;
+ Object_Directory :=
+ Project_Tree.Projects.Table (Actual_Project).Object_Directory;
-- Set the working directory to the object directory of the actual
-- project.
- Change_Dir
- (Get_Name_String
- (Project_Tree.Projects.Table
- (Actual_Project).Object_Directory));
+ if Verbose_Mode then
+ Write_Str ("Changing to object directory of """);
+ Write_Name
+ (Project_Tree.Projects.Table (Actual_Project).Display_Name);
+ Write_Str (""": """);
+ Write_Name (Object_Directory);
+ Write_Line ("""");
+ end if;
+ Change_Dir (Get_Name_String (Object_Directory));
end if;
exception
function New_Spec (Uname : Unit_Name_Type) return Boolean;
-- Uname is the name of the spec or body of some ada unit. This
-- function returns True if the Uname is the name of a body which has
- -- a spec not mentioned inali file A. If True is returned
+ -- a spec not mentioned in ALI file A. If True is returned
-- Spec_File_Name above is set to the name of this spec file.
--------------
-- appear in the Sdep section of Lib_File, New_Spec contains the file
-- name of this new spec.
- Source_Name : Name_Id;
+ Source_Name : File_Name_Type;
Text : Text_Buffer_Ptr;
Prev_Switch : String_Access;
-- Process linker options from the ALI files
for Opt in 1 .. Linker_Options.Last loop
- Check_File (Linker_Options.Table (Opt).Name);
+ Check_File (File_Name_Type (Linker_Options.Table (Opt).Name));
end loop;
-- Process options given on the command line
while Data.Extended_By /= No_Project loop
Arguments_Project := Data.Extended_By;
- Data :=
- Project_Tree.Projects.Table (Arguments_Project);
+ Data := Project_Tree.Projects.Table (Arguments_Project);
end loop;
-- If building a dynamic or relocatable library, compile with
Data;
end if;
- -- We now look for package Compiler
- -- and get the switches from this package.
+ -- We now look for package Compiler and get the switches from
+ -- this package.
Compiler_Package :=
Prj.Util.Value_Of
if Compiler_Package /= No_Package then
- -- If package Gnatmake.Compiler exists, we get
- -- the specific switches for the current source,
- -- or the global switches, if any.
+ -- If package Gnatmake.Compiler exists, we get the specific
+ -- switches for the current source, or the global switches,
+ -- if any.
- Switches := Switches_Of
- (Source_File => Source_File,
- Source_File_Name => Source_File_Name,
- Source_Index => Source_Index,
- Naming => Data.Naming,
- In_Package => Compiler_Package,
- Allow_ALI => False);
+ Switches :=
+ Switches_Of
+ (Source_File => Source_File,
+ Source_File_Name => Source_File_Name,
+ Source_Index => Source_Index,
+ Naming => Data.Naming,
+ In_Package => Compiler_Package,
+ Allow_ALI => False);
end if;
procedure Compile_Sources
(Main_Source : File_Name_Type;
Args : Argument_List;
- First_Compiled_File : out Name_Id;
- Most_Recent_Obj_File : out Name_Id;
+ First_Compiled_File : out File_Name_Type;
+ Most_Recent_Obj_File : out File_Name_Type;
Most_Recent_Obj_Stamp : out Time_Stamp_Type;
Main_Unit : out Boolean;
Compilation_Failures : out Natural;
Sfile : File_Name_Type;
-- Contains the source file of the units withed by Source_File
+ Uname : Unit_Name_Type;
+ -- Contains the unit name of the units withed by Source_File
+
ALI : ALI_Id;
-- ALI Id of the current ALI file
-- Collect arguments from project file (if any) and compile
function Compile
- (S : Name_Id;
- L : Name_Id;
+ (S : File_Name_Type;
+ L : File_Name_Type;
Source_Index : Int;
Args : Argument_List) return Process_Id;
- -- Compiles S using Args. If S is a GNAT predefined source
- -- "-gnatpg" is added to Args. Non blocking call. L corresponds to the
- -- expected library file name. Process_Id of the process spawned to
- -- execute the compile.
+ -- Compiles S using Args. If S is a GNAT predefined source "-gnatpg" is
+ -- added to Args. Non blocking call. L corresponds to the expected
+ -- library file name. Process_Id of the process spawned to execute the
+ -- compilation.
package Good_ALI is new Table.Table (
Table_Component_Type => ALI_Id,
procedure Await_Compile
(Sfile : out File_Name_Type;
Afile : out File_Name_Type;
- Uname : out File_Name_Type;
+ Uname : out Unit_Name_Type;
OK : out Boolean)
is
- Pid : Process_Id;
+ Pid : Process_Id;
Project : Project_Id;
begin
Sfile := No_File;
Afile := No_File;
- Uname := No_Name;
+ Uname := No_Unit_Name;
OK := False;
-- The loop here is a work-around for a problem on VMS; in some
if not Targparm.Suppress_Standard_Library_On_Target then
declare
- Sfile : Name_Id;
+ Sfile : File_Name_Type;
Add_It : Boolean := True;
begin
if not Project_Tree.Projects.Table
(Arguments_Project).Externally_Built
then
- Prj.Env.Set_Ada_Paths
- (Arguments_Project, Project_Tree, True);
+ Prj.Env.Set_Ada_Paths (Arguments_Project, Project_Tree, True);
if not Unique_Compile
and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None
Pid := Compile (Arguments_Path_Name, Lib_File, Source_Index,
Arguments (1 .. Last_Argument));
+
+ -- Register compiled unit into Full_Source_File as this is the
+ -- variable used to report errors.
+
+ Full_Source_File := Arguments_Path_Name;
Process_Created := True;
end if;
-------------
function Compile
- (S : Name_Id;
- L : Name_Id;
+ (S : File_Name_Type;
+ L : File_Name_Type;
Source_Index : Int;
Args : Argument_List) return Process_Id
is
Comp_Last : Integer;
Arg_Index : Integer;
- function Ada_File_Name (Name : Name_Id) return Boolean;
+ function Ada_File_Name (Name : File_Name_Type) return Boolean;
-- Returns True if Name is the name of an ada source file
-- (i.e. suffix is .ads or .adb)
-- Ada_File_Name --
-------------------
- function Ada_File_Name (Name : Name_Id) return Boolean is
+ function Ada_File_Name (Name : File_Name_Type) return Boolean is
begin
Get_Name_String (Name);
return
end;
end if;
- if Source_Index /= 0 or else
- L /= Strip_Directory (L) or else
- Object_Directory_Path /= null
+ if Source_Index /= 0
+ or else L /= Strip_Directory (L)
+ or else Object_Directory_Path /= null
then
-- Build -o argument
Comp_Last := Comp_Last + 1;
Comp_Args (Comp_Last) := new String'(Name_Buffer (1 .. Name_Len));
- GNAT.OS_Lib.Normalize_Arguments (Comp_Args (Args'First .. Comp_Last));
+ System.OS_Lib.Normalize_Arguments
+ (Comp_Args (Args'First .. Comp_Last));
Comp_Last := Comp_Last + 1;
Comp_Args (Comp_Last) := new String'("-gnatez");
end if;
return
- GNAT.OS_Lib.Non_Blocking_Spawn
+ System.OS_Lib.Non_Blocking_Spawn
(Gcc_Path.all, Comp_Args (Args'First .. Comp_Last));
end Compile;
-- Package and Queue initializations
Good_ALI.Init;
- Output.Set_Standard_Error;
if First_Q_Initialization then
Init_Q;
-- Check that switch -x has been used if a source
-- outside of project files need to be compiled.
- if Main_Project /= No_Project and then
- Arguments_Project = No_Project and then
- not External_Unit_Compilation_Allowed
+ if Main_Project /= No_Project
+ and then Arguments_Project = No_Project
+ and then not External_Unit_Compilation_Allowed
then
Make_Failed ("external source (",
Get_Name_String (Source_File),
if Process_Created then
if Pid = Invalid_Pid then
Record_Failure (Full_Source_File, Source_Unit);
+
else
Add_Process
(Pid,
Units.Table (J).First_With .. Units.Table (J).Last_With
loop
Sfile := Withs.Table (K).Sfile;
- Add_Dependency (ALIs.Table (ALI).Sfile, Sfile);
+ Uname := Withs.Table (K).Uname;
+
+ -- If project files are used, find the proper source
+ -- to compile, in case Sfile is the spec, but there
+ -- is a body.
+
+ if Main_Project /= No_Project then
+ declare
+ Unit_Name : Name_Id;
+ Uid : Prj.Unit_Id;
+ Udata : Unit_Data;
+
+ begin
+ Get_Name_String (Uname);
+ Name_Len := Name_Len - 2;
+ Unit_Name := Name_Find;
+ Uid :=
+ Units_Htable.Get
+ (Project_Tree.Units_HT, Unit_Name);
+
+ if Uid /= Prj.No_Unit then
+ Udata := Project_Tree.Units.Table (Uid);
+
+ if Udata.File_Names (Body_Part).Name /=
+ No_File
+ then
+ Sfile := Udata.File_Names (Body_Part).Name;
+ Source_Index :=
+ Udata.File_Names (Body_Part).Index;
+
+ elsif Udata.File_Names (Specification).Name /=
+ No_File
+ then
+ Sfile :=
+ Udata.File_Names (Specification).Name;
+ Source_Index :=
+ Udata.File_Names (Specification).Index;
+ end if;
+ end if;
+ end;
+ end if;
+
+ Dependencies.Append ((ALIs.Table (ALI).Sfile, Sfile));
if Is_In_Obsoleted (Sfile) then
Executable_Obsolete := True;
Debug_Msg ("Skipping internal file:", Sfile);
else
- Insert_Q
- (Sfile, Withs.Table (K).Uname, Source_Index);
+ Insert_Q (Sfile, Uname, Source_Index);
Mark (Sfile, Source_Index);
end if;
end if;
Last : Natural := 0;
function Absolute_Path
- (Path : Name_Id;
+ (Path : File_Name_Type;
Project : Project_Id) return String;
-- Returns an absolute path for a configuration pragmas file
-------------------
function Absolute_Path
- (Path : Name_Id;
+ (Path : File_Name_Type;
Project : Project_Id) return String
is
begin
Parent_Directory : constant String :=
Get_Name_String
(Project_Tree.Projects.Table
- (Project).Directory);
+ (Project).Display_Directory);
begin
if Parent_Directory (Parent_Directory'Last) =
(For_Project, Main_Project, Project_Tree);
if Project_Tree.Projects.Table
- (For_Project).Config_File_Name /= No_Name
+ (For_Project).Config_File_Name /= No_Path
then
Temporary_Config_File :=
Project_Tree.Projects.Table (For_Project).Config_File_Temp;
declare
Path : constant String :=
Absolute_Path
- (Global_Attribute.Value, Global_Attribute.Project);
+ (File_Name_Type (Global_Attribute.Value),
+ Global_Attribute.Project);
+
begin
if not Is_Regular_File (Path) then
Make_Failed
declare
Path : constant String :=
Absolute_Path
- (Local_Attribute.Value, Local_Attribute.Project);
+ (File_Name_Type (Local_Attribute.Value),
+ Local_Attribute.Project);
+
begin
if not Is_Regular_File (Path) then
Make_Failed
end if;
end Debug_Msg;
+ procedure Debug_Msg (S : String; N : File_Name_Type) is
+ begin
+ Debug_Msg (S, Name_Id (N));
+ end Debug_Msg;
+
+ procedure Debug_Msg (S : String; N : Unit_Name_Type) is
+ begin
+ Debug_Msg (S, Name_Id (N));
+ end Debug_Msg;
+
---------------------------
-- Delete_All_Temp_Files --
---------------------------
Project_Tree.Projects.Table (Project).
Config_Checked := False;
Project_Tree.Projects.Table (Project).
- Config_File_Name := No_Name;
+ Config_File_Name := No_Path;
Project_Tree.Projects.Table (Project).
Config_File_Temp := False;
end if;
pragma Assert (Args'First = 1);
if Display_Executed_Programs then
- if Commands_To_Stdout then
- Set_Standard_Output;
- end if;
-
Write_Str (Program);
for J in Args'Range loop
end loop;
Write_Eol;
- Set_Standard_Error;
end if;
end Display;
-- Enter_Into_Obsoleted --
--------------------------
- procedure Enter_Into_Obsoleted (F : Name_Id) is
+ procedure Enter_Into_Obsoleted (F : File_Name_Type) is
Name : constant String := Get_Name_String (F);
- First : Natural := Name'Last;
- F2 : Name_Id := F;
+ First : Natural;
+ F2 : File_Name_Type;
begin
+ First := Name'Last;
while First > Name'First
and then Name (First - 1) /= Directory_Separator
and then Name (First - 1) /= '/'
Name_Len := 0;
Add_Str_To_Name_Buffer (Name (First .. Name'Last));
F2 := Name_Find;
+ else
+ F2 := F;
end if;
Debug_Msg ("New entry in Obsoleted table:", F2);
Obsoleted.Set (F2, True);
end Enter_Into_Obsoleted;
- ---------------------
- -- Extract_Failure --
- ---------------------
-
- procedure Extract_Failure
- (File : out File_Name_Type;
- Unit : out Unit_Name_Type;
- Found : out Boolean)
- is
- begin
- File := Bad_Compilation.Table (Bad_Compilation.Last).File;
- Unit := Bad_Compilation.Table (Bad_Compilation.Last).Unit;
- Found := Bad_Compilation.Table (Bad_Compilation.Last).Found;
- Bad_Compilation.Decrement_Last;
- end Extract_Failure;
-
--------------------
-- Extract_From_Q --
--------------------
-- Set to True when there are Stand-Alone Libraries, so that gnatbind
-- is invoked with the -F switch to force checking of elaboration flags.
- Mapping_Path : Name_Id := No_Name;
+ Mapping_Path : Path_Name_Type := No_Path;
-- The path name of the mapping file
Discard : Boolean;
if Normed_Path /= Proj_Path then
if Verbose_Mode then
+ Set_Standard_Error;
Write_Str (Normed_Path);
Write_Str (" /= ");
Write_Line (Proj_Path);
Mapping_FD : File_Descriptor := Invalid_FD;
-- A File Descriptor for an eventual mapping file
- ALI_Unit : Name_Id := No_Name;
+ ALI_Unit : Unit_Name_Type := No_Unit_Name;
-- The unit name of an ALI file
- ALI_Name : Name_Id := No_Name;
+ ALI_Name : File_Name_Type := No_File;
-- The file name of the ALI file
- ALI_Project : Project_Id := No_Project;
+ ALI_Project : Project_Id := No_Project;
-- The project of the ALI file
- Bytes : Integer;
- OK : Boolean := True;
+ Bytes : Integer;
+ OK : Boolean := True;
- Status : Boolean;
+ Status : Boolean;
-- For call to Close
begin
Unit_Table.Last (Project_Tree.Units)
loop
declare
- Unit : constant Unit_Data :=
- Project_Tree.Units.Table (J);
+ Unit : constant Unit_Data := Project_Tree.Units.Table (J);
+
begin
if Unit.Name /= No_Name then
-- If there is a body, put it in the mapping
- if Unit.File_Names (Body_Part).Name /= No_Name
+ if Unit.File_Names (Body_Part).Name /= No_File
and then Unit.File_Names (Body_Part).Project
/= No_Project
then
Get_Name_String (Unit.Name);
- Name_Buffer
- (Name_Len + 1 .. Name_Len + 2) := "%b";
+ Name_Buffer (Name_Len + 1 .. Name_Len + 2) := "%b";
Name_Len := Name_Len + 2;
ALI_Unit := Name_Find;
ALI_Name :=
Lib_File_Name
- (Unit.File_Names (Body_Part).Name);
+ (Unit.File_Names (Body_Part).Display_Name);
ALI_Project :=
Unit.File_Names (Body_Part).Project;
-- Otherwise, if there is a spec, put it
-- in the mapping.
- elsif Unit.File_Names (Specification).Name
- /= No_Name
- and then Unit.File_Names
- (Specification).Project
- /= No_Project
+ elsif Unit.File_Names (Specification).Name /= No_File
+ and then Unit.File_Names (Specification).Project /=
+ No_Project
then
Get_Name_String (Unit.Name);
- Name_Buffer
- (Name_Len + 1 .. Name_Len + 2) := "%s";
+ Name_Buffer (Name_Len + 1 .. Name_Len + 2) := "%s";
Name_Len := Name_Len + 2;
ALI_Unit := Name_Find;
- ALI_Name := Lib_File_Name
- (Unit.File_Names (Specification).Name);
+ ALI_Name :=
+ Lib_File_Name
+ (Unit.File_Names (Specification).Display_Name);
ALI_Project :=
Unit.File_Names (Specification).Project;
else
- ALI_Name := No_Name;
+ ALI_Name := No_File;
end if;
-- If we have something to put in the mapping
-- ended project obj dir as well as in the
-- extending project obj dir.
- if ALI_Name /= No_Name
+ if ALI_Name /= No_File
and then
Project_Tree.Projects.Table
(ALI_Project).Extended_By = No_Project
exit when not OK;
- -- Third line it the ALI path name.
+ -- Third line it the ALI path name
Bytes :=
Write
Failed_Links.Set_Last (0);
Successful_Links.Set_Last (0);
- if Hostparm.Java_VM then
- Gcc := new String'("jgnat");
- Gnatbind := new String'("jgnatbind");
- Gnatlink := new String'("jgnatlink");
-
- -- Do not check for an object file (".o") when compiling to
- -- Java bytecode since ".class" files are generated instead.
-
- Check_Object_Consistency := False;
- end if;
-
-- Special case when switch -B was specified
if Build_Bind_And_Link_Full_Project then
declare
Value : String_List_Id :=
- Project_Tree.Projects.Table (Main_Project).Mains;
+ Project_Tree.Projects.Table (Main_Project).Mains;
begin
-- The attribute Main is an empty list or not specified,
Do_Not_Execute := True;
end if;
- -- Note that Osint.Next_Main_Source will always return the (possibly
+ -- Note that Osint.M.Next_Main_Source will always return the (possibly
-- abbreviated file) without any directory information.
Main_Source_File := Next_Main_Source;
if Main_Project /= No_Project then
if Project_Tree.Projects.Table
- (Main_Project).Object_Directory /= No_Name
+ (Main_Project).Object_Directory /= No_Path
then
-- Change current directory to object directory of main project
- Project_Object_Directory := No_Project;
+ Project_Of_Current_Object_Directory := No_Project;
Change_To_Object_Directory (Main_Project);
end if;
not Unique_Compile);
The_Packages : constant Package_Id :=
- Project_Tree.Projects.Table (Main_Project).Decl.Packages;
+ Project_Tree.Projects.Table
+ (Main_Project).Decl.Packages;
Builder_Package : constant Prj.Package_Id :=
- Prj.Util.Value_Of
- (Name => Name_Builder,
- In_Packages => The_Packages,
- In_Tree => Project_Tree);
+ Prj.Util.Value_Of
+ (Name => Name_Builder,
+ In_Packages => The_Packages,
+ In_Tree => Project_Tree);
Binder_Package : constant Prj.Package_Id :=
- Prj.Util.Value_Of
- (Name => Name_Binder,
- In_Packages => The_Packages,
- In_Tree => Project_Tree);
+ Prj.Util.Value_Of
+ (Name => Name_Binder,
+ In_Packages => The_Packages,
+ In_Tree => Project_Tree);
Linker_Package : constant Prj.Package_Id :=
- Prj.Util.Value_Of
- (Name => Name_Linker,
- In_Packages => The_Packages,
- In_Tree => Project_Tree);
+ Prj.Util.Value_Of
+ (Name => Name_Linker,
+ In_Packages => The_Packages,
+ In_Tree => Project_Tree);
begin
-- We fail if we cannot find the main source file
begin
Targparm.Get_Target_Parameters;
-
exception
when Unrecoverable_Error =>
Make_Failed ("*** make failed.");
end;
+ -- Special processing for VM targets
+
+ if Targparm.VM_Target /= No_VM then
+
+ -- Do not check for an object file (".o") when compiling to VM
+ -- machine since ".class" files are generated instead.
+
+ Check_Object_Consistency := False;
+
+ -- Set proper processing commands
+
+ case Targparm.VM_Target is
+ when Targparm.JVM_Target =>
+ Gcc := new String'("jgnat");
+ Gnatbind := new String'("jgnatbind");
+ Gnatlink := new String'("jgnatlink");
+
+ when Targparm.CLI_Target =>
+ Gcc := new String'("dotnet-gnatcompile");
+
+ when Targparm.No_VM =>
+ raise Program_Error;
+ end case;
+ end if;
+
Display_Commands (not Quiet_Output);
Check_Steps;
and then (not Project_Tree.Projects.Table
(Proj).Externally_Built);
- if Project_Tree.Projects.Table
- (Proj).Need_To_Build_Lib
- then
+ if Project_Tree.Projects.Table (Proj).Need_To_Build_Lib then
+
-- If there is no object directory, then it will be
-- impossible to build the library. So fail immediately.
- if Project_Tree.Projects.Table
- (Proj).Object_Directory = No_Name
+ if Project_Tree.Projects.Table (Proj).Object_Directory =
+ No_Path
then
Make_Failed
("no object files to build library for project """,
if Saved_Linker_Switches.Table (J).all = Output_Flag.all then
declare
Exec_File_Name : constant String :=
- Saved_Linker_Switches.Table (J + 1).all;
+ Saved_Linker_Switches.Table (J + 1).all;
begin
if not Is_Absolute_Path (Exec_File_Name) then
declare
Dir_Path : constant String_Access :=
- new String'(Get_Name_String
- (Project_Tree.Projects.Table
- (Main_Project).Directory));
+ new String'(Get_Name_String
+ (Project_Tree.Projects.Table
+ (Main_Project).Directory));
begin
for J in 1 .. Binder_Switches.Last loop
Test_If_Relative_Path
Gnatlink := Saved_Gnatlink;
end if;
- Gcc_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all);
- Gnatbind_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatbind.all);
- Gnatlink_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatlink.all);
+ Gcc_Path := System.OS_Lib.Locate_Exec_On_Path (Gcc.all);
+ Gnatbind_Path := System.OS_Lib.Locate_Exec_On_Path (Gnatbind.all);
+ Gnatlink_Path := System.OS_Lib.Locate_Exec_On_Path (Gnatlink.all);
-- If we have specified -j switch both from the project file
-- and on the command line, the one from the command line takes
-- number of compilation processed, for each possible project.
The_Mapping_File_Names :=
- new Temp_File_Names
+ new Temp_Path_Names
(No_Project .. Project_Table.Last (Project_Tree.Projects),
1 .. Saved_Maximum_Processes);
Last_Mapping_File_Names :=
if Main_Project /= No_Project then
declare
Exec_File_Name : constant String :=
- Get_Name_String (Executable);
+ Get_Name_String (Executable);
begin
if not Is_Absolute_Path (Exec_File_Name) then
Get_Name_String (Project_Tree.Projects.Table
- (Main_Project).Exec_Directory);
+ (Main_Project).Display_Exec_Dir);
if
Name_Buffer (Name_Len) /= Directory_Separator
if Do_Compile_Step then
Recursive_Compilation_Step : declare
- Args : Argument_List (1 .. Gcc_Switches.Last);
+ Args : Argument_List (1 .. Gcc_Switches.Last);
- First_Compiled_File : Name_Id;
- Youngest_Obj_File : Name_Id;
+ First_Compiled_File : File_Name_Type;
+ Youngest_Obj_File : File_Name_Type;
Youngest_Obj_Stamp : Time_Stamp_Type;
- Executable_Stamp : Time_Stamp_Type;
+ Executable_Stamp : Time_Stamp_Type;
-- Executable is the final executable program
- Library_Rebuilt : Boolean := False;
+ Library_Rebuilt : Boolean := False;
begin
for J in 1 .. Gcc_Switches.Last loop
goto Next_Main;
else
List_Bad_Compilations;
- raise Compilation_Failed;
+ Report_Compilation_Failed;
end if;
end if;
--------------------------
procedure Add_To_Library_Projs (Proj : Project_Id) is
- Prj : Project_Id;
+ Prj : Project_Id;
begin
Library_Projs.Increment_Last;
-- since there is currently no simple way to check the
-- up-to-date status of objects
- if not Hostparm.Java_VM
+ if Targparm.VM_Target = No_VM
and then First_Compiled_File = No_File
then
- Executable_Stamp := File_Stamp (Executable);
+ Executable_Stamp := File_Stamp (Executable);
if not Executable_Obsolete then
Executable_Obsolete :=
elsif Youngest_Obj_Stamp (1) = ' ' then
Verbose_Msg
- (Youngest_Obj_File,
- "missing.",
- Prefix => " ");
+ (Youngest_Obj_File, "missing.", Prefix => " ");
elsif Youngest_Obj_Stamp > Executable_Stamp then
Verbose_Msg
else
Verbose_Msg
- (Executable, "needs to be rebuild.",
- Prefix => " ");
+ (Executable, "needs to be rebuilt", Prefix => " ");
end if;
end if;
-- Check if there are shared libraries, so that gnatbind is
-- called with -shared. Check also if gnatbind is called with
-- -shared, so that gnatlink is called with -shared-libgcc
- -- for GCC version 3 and above, ensuring that the shared
- -- version of libgcc will be used.
+ -- ensuring that the shared version of libgcc will be used.
if Main_Project /= No_Project
and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None
end if;
-- If there are shared libraries, invoke gnatlink with
- -- -shared-libgcc if GCC version is 3 or more.
+ -- -shared-libgcc.
- if Shared_Libs and then GCC_Version >= 3 then
+ if Shared_Libs then
Link_With_Shared_Libgcc := Shared_Libgcc_Switch'Access;
end if;
-- file, if one was created.
if not Debug.Debug_Flag_N
- and then Mapping_Path /= No_Name
+ and then Mapping_Path /= No_Path
then
Delete_File (Get_Name_String (Mapping_Path), Discard);
end if;
-- If -dn was not specified, delete the temporary mapping file,
-- if one was created.
- if not Debug.Debug_Flag_N and then Mapping_Path /= No_Name then
+ if not Debug.Debug_Flag_N and then Mapping_Path /= No_Path then
Delete_File (Get_Name_String (Mapping_Path), Discard);
end if;
end Bind_Step;
if Do_Link_Step then
Link_Step : declare
- There_Are_Libraries : Boolean := False;
Linker_Switches_Last : constant Integer := Linker_Switches.Last;
- Path_Option : constant String_Access :=
- MLib.Linker_Library_Path_Option;
- Current : Natural;
- Proj2 : Project_Id;
- Depth : Natural;
+ Path_Option : constant String_Access :=
+ MLib.Linker_Library_Path_Option;
+ There_Are_Libraries : Boolean := False;
+ Current : Natural;
+ Proj2 : Project_Id;
+ Depth : Natural;
begin
if not Run_Path_Option then
-- Add this project to table Library_Projs
There_Are_Libraries := True;
- Depth :=
- Project_Tree.Projects.Table (Proj1).Depth;
+ Depth := Project_Tree.Projects.Table (Proj1).Depth;
Library_Projs.Increment_Last;
Current := Library_Projs.Last;
new String'
(Get_Name_String
(Project_Tree.Projects.Table
- (Proj1).Library_Dir));
+ (Proj1).Display_Library_Dir));
end if;
end if;
end loop;
Get_Name_String
(Project_Tree.Projects.Table
(Library_Projs.Table (Index)).
- Library_Dir));
+ Display_Library_Dir));
-- Add the -l switch
-- And invoke the linker
+ declare
+ Success : Boolean := False;
begin
Link (Main_ALI_File,
Link_With_Shared_Libgcc.all &
- Args (Args'First .. Last_Arg));
- Successful_Links.Increment_Last;
- Successful_Links.Table (Successful_Links.Last) :=
- Main_ALI_File;
+ Args (Args'First .. Last_Arg),
+ Success);
- exception
- when Link_Failed =>
- if Osint.Number_Of_Files = 1 or not Keep_Going then
- raise;
+ if Success then
+ Successful_Links.Increment_Last;
+ Successful_Links.Table (Successful_Links.Last) :=
+ Main_ALI_File;
- else
- Write_Line ("*** link failed");
- Failed_Links.Increment_Last;
- Failed_Links.Table (Failed_Links.Last) :=
- Main_ALI_File;
+ elsif Osint.Number_Of_Files = 1 or not Keep_Going then
+ Make_Failed ("*** link failed.");
+
+ else
+ Set_Standard_Error;
+ Write_Line ("*** link failed");
+
+ if Commands_To_Stdout then
+ Set_Standard_Output;
end if;
+
+ Failed_Links.Increment_Last;
+ Failed_Links.Table (Failed_Links.Last) :=
+ Main_ALI_File;
+ end if;
end;
end;
Write_Line (""" succeeded.");
end loop;
+ Set_Standard_Error;
+
for Index in 1 .. Failed_Links.Last loop
Write_Str ("Linking of """);
Write_Str (Get_Name_String (Failed_Links.Table (Index)));
Write_Line (""" failed.");
end loop;
+ if Commands_To_Stdout then
+ Set_Standard_Output;
+ end if;
+
if Total_Compilation_Failures = 0 then
- raise Compilation_Failed;
+ Report_Compilation_Failed;
end if;
end if;
if Total_Compilation_Failures /= 0 then
List_Bad_Compilations;
- raise Compilation_Failed;
+ Report_Compilation_Failed;
end if;
-- Delete the temporary mapping file that was created if we are
Prj.Env.Delete_All_Path_Files (Project_Tree);
end if;
- Exit_Program (E_Success);
-
exception
- when Bind_Failed =>
- Make_Failed ("*** bind failed.");
-
- when Compilation_Failed =>
- if not Debug.Debug_Flag_N then
- Delete_Mapping_Files;
- Prj.Env.Delete_All_Path_Files (Project_Tree);
- end if;
-
- Exit_Program (E_Fatal);
-
- when Link_Failed =>
- Make_Failed ("*** link failed.");
-
when X : others =>
+ Set_Standard_Error;
Write_Line (Exception_Information (X));
Make_Failed ("INTERNAL ERROR. Please report.");
end Gnatmake;
-- Hash --
----------
- function Hash (F : Name_Id) return Header_Num is
+ function Hash (F : File_Name_Type) return Header_Num is
begin
return Header_Num (1 + F mod Max_Header);
end Hash;
--------------------
function In_Ada_Lib_Dir (File : File_Name_Type) return Boolean is
- D : constant Name_Id := Get_Directory (File);
- B : constant Byte := Get_Name_Table_Byte (D);
+ D : constant File_Name_Type := Get_Directory (File);
+ B : constant Byte := Get_Name_Table_Byte (D);
begin
return (B and Ada_Lib_Dir) /= 0;
end In_Ada_Lib_Dir;
-- Inform --
------------
- procedure Inform (N : Name_Id := No_Name; Msg : String) is
+ procedure Inform (N : Name_Id; Msg : String) is
begin
Osint.Write_Program_Name;
Write_Eol;
end Inform;
+ procedure Inform (N : File_Name_Type; Msg : String) is
+ begin
+ Inform (Name_Id (N), Msg);
+ end Inform;
+
+ procedure Inform (Msg : String) is
+ begin
+ Osint.Write_Program_Name;
+ Write_Str (": ");
+ Write_Str (Msg);
+ Write_Eol;
+ end Inform;
+
-----------------------
-- Init_Mapping_File --
-----------------------
(Project : Project_Id;
File_Index : in out Natural)
is
- FD : File_Descriptor;
-
+ FD : File_Descriptor;
Status : Boolean;
-- For call to Close
Scan_Make_Arg (Argument (Next_Arg), And_Save => True);
end loop Scan_Args;
+ if Commands_To_Stdout then
+ Set_Standard_Output;
+ end if;
+
if Usage_Requested then
Usage;
end if;
if Verbose_Mode then
Write_Eol;
- Write_Str ("Parsing Project File """);
+ Write_Str ("Parsing project file """);
Write_Str (Project_File_Name.all);
Write_Str (""".");
Write_Eol;
Make_Failed ("""", Project_File_Name.all, """ processing failed");
end if;
+ Create_Mapping_File := True;
+
if Verbose_Mode then
Write_Eol;
- Write_Str ("Parsing of Project File """);
+ Write_Str ("Parsing of project file """);
Write_Str (Project_File_Name.all);
Write_Str (""" is finished.");
Write_Eol;
-- Make sure no project object directory is recorded
- Project_Object_Directory := No_Project;
-
+ Project_Of_Current_Object_Directory := No_Project;
end Initialize;
----------------------------
is
Put_In_Q : Boolean := Into_Q;
Unit : Unit_Data;
- Sfile : Name_Id;
+ Sfile : File_Name_Type;
Extending : constant Boolean :=
Project_Tree.Projects.Table
Unit_Table.Last (Project_Tree.Units)
loop
Unit := Project_Tree.Units.Table (Id);
- Sfile := No_Name;
+ Sfile := No_File;
-- If there is a source for the body, and the body has not been
-- locally removed,
- if Unit.File_Names (Body_Part).Name /= No_Name
+ if Unit.File_Names (Body_Part).Name /= No_File
and then Unit.File_Names (Body_Part).Path /= Slash
then
-- And it is a source for the specified project
-- If we don't have a spec, we cannot consider the source
-- if it is a subunit
- if Unit.File_Names (Specification).Name = No_Name then
+ if Unit.File_Names (Specification).Name = No_File then
declare
Src_Ind : Source_File_Index;
-- (Atree, Sinfo, ...). So, we pretend that it is a
-- project file, and we use Sinput.P.
- -- Source_File_Is_Subunit is just scanning through
- -- the file until it finds one of the reserved words
+ -- Source_File_Is_Subunit is just scanning through the
+ -- file until it finds one of the reserved words
-- separate, procedure, function, generic or package.
-- Fortunately, these Ada reserved words are also
-- reserved for project files.
-- If it is a subunit, discard it
if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
- Sfile := No_Name;
+ Sfile := No_File;
else
- Sfile := Unit.File_Names (Body_Part).Name;
+ Sfile := Unit.File_Names (Body_Part).Display_Name;
end if;
end;
else
- Sfile := Unit.File_Names (Body_Part).Name;
+ Sfile := Unit.File_Names (Body_Part).Display_Name;
end if;
end if;
- elsif Unit.File_Names (Specification).Name /= No_Name
+ elsif Unit.File_Names (Specification).Name /= No_File
and then Unit.File_Names (Specification).Path /= Slash
and then Check_Project (Unit.File_Names (Specification).Project)
then
-- for the spec which has not been locally removed, then we take
-- this one.
- Sfile := Unit.File_Names (Specification).Name;
+ Sfile := Unit.File_Names (Specification).Display_Name;
end if;
-- If Put_In_Q is True, we insert into the Q
-- And of course, we only insert in the Q if the source is not
-- marked.
- if Sfile /= No_Name and then not Is_Marked (Sfile) then
+ if Sfile /= No_File and then not Is_Marked (Sfile) then
if Verbose_Mode then
Write_Str ("Adding """);
Write_Str (Get_Name_String (Sfile));
Mark (Sfile);
end if;
- elsif Sfile /= No_Name then
+ elsif Sfile /= No_File then
-- If Put_In_Q is False, we add the source as it it were specified
-- on the command line, and we set Put_In_Q to True, so that the
procedure Insert_Q
(Source_File : File_Name_Type;
- Source_Unit : Unit_Name_Type := No_Name;
+ Source_Unit : Unit_Name_Type := No_Unit_Name;
Index : Int := 0)
is
begin
-- Is_In_Obsoleted --
---------------------
- function Is_In_Obsoleted (F : Name_Id) return Boolean is
+ function Is_In_Obsoleted (F : File_Name_Type) return Boolean is
begin
if F = No_File then
return False;
else
declare
Name : constant String := Get_Name_String (F);
- First : Natural := Name'Last;
- F2 : Name_Id := F;
+ First : Natural;
+ F2 : File_Name_Type;
begin
+ First := Name'Last;
while First > Name'First
and then Name (First - 1) /= Directory_Separator
and then Name (First - 1) /= '/'
Name_Len := 0;
Add_Str_To_Name_Buffer (Name (First .. Name'Last));
F2 := Name_Find;
+ else
+ F2 := F;
end if;
return Obsoleted.Get (F2);
Source_File_Name : constant String :=
Get_Name_String (Source_File);
Saved_Verbosity : constant Verbosity := Current_Verbosity;
- Project : Project_Id := No_Project;
- Path_Name : Name_Id := No_Name;
+ Project : Project_Id := No_Project;
+ Path_Name : File_Name_Type := No_File;
Data : Project_Data;
begin
-- messages.
Current_Verbosity := Default;
- Prj.Env.
- Get_Reference
+ Prj.Env.Get_Reference
(Source_File_Name => Source_File_Name,
Project => Project,
In_Tree => Project_Tree,
Object_Directory : constant String :=
Normalize_Pathname
(Get_Name_String
- (Data.Object_Directory));
+ (Data.Display_Object_Dir));
Olast : Natural := Object_Directory'Last;
-- Link --
----------
- procedure Link (ALI_File : File_Name_Type; Args : Argument_List) is
+ procedure Link
+ (ALI_File : File_Name_Type;
+ Args : Argument_List;
+ Success : out Boolean)
+ is
Link_Args : Argument_List (1 .. Args'Length + 1);
- Success : Boolean;
begin
Get_Name_String (ALI_File);
Link_Args (2 .. Args'Length + 1) := Args;
- GNAT.OS_Lib.Normalize_Arguments (Link_Args);
+ System.OS_Lib.Normalize_Arguments (Link_Args);
Display (Gnatlink.all, Link_Args);
Make_Failed ("error, unable to locate ", Gnatlink.all);
end if;
- GNAT.OS_Lib.Spawn (Gnatlink_Path.all, Link_Args, Success);
-
- if not Success then
- raise Link_Failed;
- end if;
+ System.OS_Lib.Spawn (Gnatlink_Path.all, Link_Args, Success);
end Link;
---------------------------
-----------------
procedure List_Depend is
- Lib_Name : Name_Id;
- Obj_Name : Name_Id;
- Src_Name : Name_Id;
+ Lib_Name : File_Name_Type;
+ Obj_Name : File_Name_Type;
+ Src_Name : File_Name_Type;
Len : Natural;
Line_Pos : Natural;
Write_Eol;
end loop;
- Set_Standard_Error;
+ if not Commands_To_Stdout then
+ Set_Standard_Error;
+ end if;
end List_Depend;
-----------------
begin
if On_Command_Line then
declare
- Real_Path : constant String :=
- Normalize_Pathname (Dir);
+ Real_Path : constant String := Normalize_Pathname (Dir);
begin
if Real_Path'Length = 0 then
declare
Real_Path : constant String :=
Normalize_Pathname
- (Dir,
- Get_Name_String
- (Project_Tree.Projects.Table (Main_Project).Directory));
+ (Dir, Get_Name_String
+ (Project_Tree.Projects.Table
+ (Main_Project).Display_Directory));
begin
if Real_Path'Length = 0 then
List := Project_Tree.Project_Lists.Table (List).Next;
Recursive_Compute_Depth
(Project => Proj,
- Depth => Depth + 1);
+ Depth => Depth + 1);
end loop;
-- Visit a project being extended, if any
Project_Tree.Projects.Table (Project).Seen := False;
end Recursive_Compute_Depth;
+ -------------------------------
+ -- Report_Compilation_Failed --
+ -------------------------------
+
+ procedure Report_Compilation_Failed is
+ begin
+ if not Debug.Debug_Flag_N then
+ Delete_Mapping_Files;
+ Prj.Env.Delete_All_Path_Files (Project_Tree);
+ end if;
+
+ Exit_Program (E_Fatal);
+ end Report_Compilation_Failed;
+
-----------------------
-- Sigint_Intercpted --
-----------------------
procedure Sigint_Intercepted is
begin
+ Set_Standard_Error;
Write_Line ("*** Interrupted ***");
Delete_All_Temp_Files;
OS_Exit (1);
then
Unique_Compile_All_Projects := True;
Unique_Compile := True;
- Compile_Only := True;
+ Compile_Only := True;
Do_Bind_Step := False;
Do_Link_Step := False;
Operating_Mode := Check_Semantics;
Check_Object_Consistency := False;
Compile_Only := True;
- Do_Bind_Step := False;
- Do_Link_Step := False;
+ Do_Bind_Step := False;
+ Do_Link_Step := False;
elsif Argv (2 .. Argv'Last) = "nostdlib" then
-----------------
function Switches_Of
- (Source_File : Name_Id;
+ (Source_File : File_Name_Type;
Source_File_Name : String;
Source_Index : Int;
Naming : Naming_Data;
begin
Switches :=
Prj.Util.Value_Of
- (Index => Source_File,
+ (Index => Name_Id (Source_File),
Src_Index => Source_Index,
In_Array => Switches_Array,
In_Tree => Project_Tree);
Write_Eol;
end Verbose_Msg;
+ procedure Verbose_Msg
+ (N1 : File_Name_Type;
+ S1 : String;
+ N2 : File_Name_Type := No_File;
+ S2 : String := "";
+ Prefix : String := " -> ";
+ Minimum_Verbosity : Verbosity_Level_Type := Opt.Low)
+ is
+ begin
+ Verbose_Msg
+ (Name_Id (N1), S1, Name_Id (N2), S2, Prefix, Minimum_Verbosity);
+ end Verbose_Msg;
+
begin
-- Make sure that in case of failure, the temp files will be deleted
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
------------------------------------------------------------------------------
-- The following package implements the facilities to recursively
--- compile (a la make), bind and/or link a set of sources. This package
--- gives the individual routines for performing such tasks as well as
--- the routine gnatmake below that puts it all together.
-
-with Table;
-with Types; use Types;
-
-with GNAT.OS_Lib; use GNAT.OS_Lib;
+-- compile (a la make), bind and/or link a set of sources.
package Make is
- -- The 3 following packages are used to store gcc, gnatbind and gnatbl
- -- switches passed on the gnatmake or gnatdist command line.
- -- Note that the lower bounds definitely need to be 1 to match the
- -- requirement that the argument array prepared for Spawn must have
- -- a lower bound of 1.
-
- package Gcc_Switches is new Table.Table (
- Table_Component_Type => String_Access,
- Table_Index_Type => Integer,
- Table_Low_Bound => 1,
- Table_Initial => 20,
- Table_Increment => 100,
- Table_Name => "Make.Gcc_Switches");
-
- package Binder_Switches is new Table.Table (
- Table_Component_Type => String_Access,
- Table_Index_Type => Integer,
- Table_Low_Bound => 1,
- Table_Initial => 20,
- Table_Increment => 100,
- Table_Name => "Make.Binder_Switches");
-
- package Linker_Switches is new Table.Table (
- Table_Component_Type => String_Access,
- Table_Index_Type => Integer,
- Table_Low_Bound => 1,
- Table_Initial => 20,
- Table_Increment => 100,
- Table_Name => "Make.Linker_Switches");
-
- procedure Display_Commands (Display : Boolean := True);
- -- The default behavior of Make commands (Compile_Sources, Bind, Link)
- -- is to display them on stderr. This behavior can be changed repeatedly
- -- by invoking this procedure.
-
- -- If a compilation, bind or link failed one of the following 3 exceptions
- -- is raised. These need to be handled by the calling routines.
-
- Compilation_Failed : exception;
- -- Raised by Compile_Sources if a compilation failed
-
- Bind_Failed : exception;
- -- Raised by Bind below if the bind failed
-
- Link_Failed : exception;
- -- Raised by Link below if the link failed
-
- procedure Bind (ALI_File : File_Name_Type; Args : Argument_List);
- -- Binds ALI_File. Args are the arguments to pass to the binder.
- -- Args must have a lower bound of 1.
-
- procedure Link (ALI_File : File_Name_Type; Args : Argument_List);
- -- Links ALI_File. Args are the arguments to pass to the linker.
- -- Args must have a lower bound of 1.
-
- procedure Initialize;
- -- Performs default and package initialization. Therefore,
- -- Compile_Sources can be called by an external unit.
-
- procedure Scan_Make_Arg (Argv : String; And_Save : Boolean);
- -- Scan make arguments. Argv is a single argument to be processed
-
- procedure Extract_Failure
- (File : out File_Name_Type;
- Unit : out Unit_Name_Type;
- Found : out Boolean);
- -- Extracts the first failure report from Bad_Compilation table
-
- procedure Compile_Sources
- (Main_Source : File_Name_Type;
- Args : Argument_List;
- First_Compiled_File : out Name_Id;
- Most_Recent_Obj_File : out Name_Id;
- Most_Recent_Obj_Stamp : out Time_Stamp_Type;
- Main_Unit : out Boolean;
- Compilation_Failures : out Natural;
- Main_Index : Int := 0;
- Check_Readonly_Files : Boolean := False;
- Do_Not_Execute : Boolean := False;
- Force_Compilations : Boolean := False;
- Keep_Going : Boolean := False;
- In_Place_Mode : Boolean := False;
- Initialize_ALI_Data : Boolean := True;
- Max_Process : Positive := 1);
- -- Compile_Sources will recursively compile all the sources needed by
- -- Main_Source. Before calling this routine make sure Namet has been
- -- initialized. This routine can be called repeatedly with different
- -- Main_Source file as long as all the source (-I flags), library
- -- (-B flags) and ada library (-A flags) search paths between calls are
- -- *exactly* the same. The default directory must also be the same.
- --
- -- Args contains the arguments to use during the compilations.
- -- The lower bound of Args must be 1.
- --
- -- First_Compiled_File is set to the name of the first file that is
- -- compiled or that needs to be compiled. This is set to No_Name if no
- -- compilations were needed.
- --
- -- Most_Recent_Obj_File is set to the full name of the most recent
- -- object file found when no compilations are needed, that is when
- -- First_Compiled_File is set to No_Name. When First_Compiled_File
- -- is set then Most_Recent_Obj_File is set to No_Name.
- --
- -- Most_Recent_Obj_Stamp is the time stamp of Most_Recent_Obj_File.
- --
- -- Main_Unit is set to True if Main_Source can be a main unit.
- -- If Do_Not_Execute is False and First_Compiled_File /= No_Name
- -- the value of Main_Unit is always False.
- -- Is this used any more??? It is certainly not used by gnatmake???
- --
- -- Compilation_Failures is a count of compilation failures. This count
- -- is used to extract compilation failure reports with Extract_Failure.
- --
- -- Main_Index, when not zero, is the index of the main unit in source
- -- file Main_Source which is a multi-unit source.
- -- Zero indicates that Main_Source is a single unit source file.
- --
- -- Check_Readonly_Files set it to True to compile source files
- -- which library files are read-only. When compiling GNAT predefined
- -- files the "-gnatg" flag is used.
- --
- -- Do_Not_Execute set it to True to find out the first source that
- -- needs to be recompiled, but without recompiling it. This file is
- -- saved in First_Compiled_File.
- --
- -- Force_Compilations forces all compilations no matter what but
- -- recompiles read-only files only if Check_Readonly_Files
- -- is set.
- --
- -- Keep_Going when True keep compiling even in the presence of
- -- compilation errors.
- --
- -- In_Place_Mode when True save library/object files in their object
- -- directory if they already exist; otherwise, in the source directory.
- --
- -- Initialize_ALI_Data set it to True when you want to initialize ALI
- -- data-structures. This is what you should do most of the time.
- -- (especially the first time around when you call this routine).
- -- This parameter is set to False to preserve previously recorded
- -- ALI file data.
- --
- -- Max_Process is the maximum number of processes that should be spawned
- -- to carry out compilations.
- --
- -- Flags in Package Opt Affecting Compile_Sources
- -- -----------------------------------------------
- --
- -- Check_Object_Consistency set it to False to omit all consistency
- -- checks between an .ali file and its corresponding object file.
- -- When this flag is set to true, every time an .ali is read,
- -- package Osint checks that the corresponding object file
- -- exists and is more recent than the .ali.
- --
- -- Use of Name Table Info
- -- ----------------------
- --
- -- All file names manipulated by Compile_Sources are entered into the
- -- Names table. The Byte field of a source file is used to mark it.
- --
- -- Calling Compile_Sources Several Times
- -- -------------------------------------
- --
- -- Upon return from Compile_Sources all the ALI data structures are left
- -- intact for further browsing. HOWEVER upon entry to this routine ALI
- -- data structures are re-initialized if parameter Initialize_ALI_Data
- -- above is set to true. Typically this is what you want the first time
- -- you call Compile_Sources. You should not load an ali file, call this
- -- routine with flag Initialize_ALI_Data set to True and then expect
- -- that ALI information to be around after the call. Note that the first
- -- time you call Compile_Sources you better set Initialize_ALI_Data to
- -- True unless you have called Initialize_ALI yourself.
- --
- -- Compile_Sources ALGORITHM : Compile_Sources (Main_Source)
- -- -------------------------
- --
- -- 1. Insert Main_Source in a Queue (Q) and mark it.
- --
- -- 2. Let unit.adb be the file at the head of the Q. If unit.adb is
- -- missing but its corresponding ali file is in an Ada library directory
- -- (see below) then, remove unit.adb from the Q and goto step 4.
- -- Otherwise, look at the files under the D (dependency) section of
- -- unit.ali. If unit.ali does not exist or some of the time stamps do
- -- not match, (re)compile unit.adb.
- --
- -- An Ada library directory is a directory containing Ada specs, ali
- -- and object files but no source files for the bodies. An Ada library
- -- directory is communicated to gnatmake by means of some switch so that
- -- gnatmake can skip the sources whole ali are in that directory.
- -- There are two reasons for skipping the sources in this case. Firstly,
- -- Ada libraries typically come without full sources but binding and
- -- linking against those libraries is still possible. Secondly, it would
- -- be very wasteful for gnatmake to systematically check the consistency
- -- of every external Ada library used in a program. The binder is
- -- already in charge of catching any potential inconsistencies.
- --
- -- 3. Look into the W section of unit.ali and insert into the Q all
- -- unmarked source files. Mark all files newly inserted in the Q.
- -- Specifically, assuming that the W section looks like
- --
- -- W types%s types.adb types.ali
- -- W unchecked_deallocation%s
- -- W xref_tab%s xref_tab.adb xref_tab.ali
- --
- -- Then xref_tab.adb and types.adb are inserted in the Q if they are not
- -- already marked.
- -- Note that there is no file listed under W unchecked_deallocation%s
- -- so no generic body should ever be explicitly compiled (unless the
- -- Main_Source at the start was a generic body).
- --
- -- 4. Repeat steps 2 and 3 above until the Q is empty
- --
- -- Note that the above algorithm works because the units withed in
- -- subunits are transitively included in the W section (with section) of
- -- the main unit. Likewise the withed units in a generic body needed
- -- during a compilation are also transitively included in the W section
- -- of the originally compiled file.
-
procedure Gnatmake;
- -- The driver of gnatmake. This routine puts it all together.
- -- This utility can be used to automatically (re)compile (using
- -- Compile_Sources), bind (using Bind) and link (using Link) a set of
- -- ada sources. For more information on gnatmake and its precise usage
- -- please refer to the gnat documentation.
- --
- -- Flags in Package Opt Affecting Gnatmake
- -- ---------------------------------------
- --
- -- Check_Readonly_Files: True when -a present in command line
- -- Check_Object_Consistency: Set to True by Gnatmake
- -- Compile_Only: True when -c present in command line
- -- Force_Compilations: True when -f present in command line
- -- Maximum_Processes: Number of processes given by -jnum
- -- Keep_Going: True when -k present in command line
- -- List_Dependencies: True when -l present in command line
- -- Do_Not_Execute True when -n present in command line
- -- Quiet_Output: True when -q present in command line
- -- Minimal_Recompilation: True when -m present in command line
- -- Verbose_Mode: True when -v present in command line
+ -- The driver of gnatmake. For more information on gnatmake and its
+ -- precise usage please refer to the gnat documentation.
end Make;
OSDN Git Service
