OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

make.adb: (Gnatmake_Called): Remove, no longer necessary 

2008-04-08  Vincent Celier  <celier@adacore.com>
	    Thomas Quinot  <quinot@adacore.com>

	* make.adb: (Gnatmake_Called): Remove, no longer necessary
	(Compile_Surces): Call Delete_Temp_Config_Files only if Gnatmake_Called
	is True and Debug_Flag_N is False. Debug_Flag_N means "keep temp files".
	(Insert_Project_Sources): Take into account index in multi-unit source
	files.
	After building a library project, delete all temporary files.
	(Initialize): Reset current output after parsing project file.
	(Collect_Arguments_And_Compile): Never insert in the queue the sources
	of library projects that are externally built.
	Put file name in error and inform messages if -df is used
	(Display): If invoked with -d7, do not display path names, but only
	file names.

	* makeutl.ads (Path_Or_File_Name): New function
	(Path_Or_File_Name): New function

From-SVN: r134039
This commit is contained in:
Vincent Celier 2008-04-08 08:52:51 +02:00 committed by Arnaud Charlet
parent f7d5442e99
commit 189641a279
2 changed files with 123 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

179
gcc/ada/make.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -589,11 +589,6 @@ package body Make is
-- Gnatmake Routines -- -- Gnatmake Routines --
----------------------- -----------------------
Gnatmake_Called : Boolean := False;
-- Set to True when procedure Gnatmake is called.
-- Attempt to delete temporary files is made only when Gnatmake_Called
-- is True.
subtype Lib_Mark_Type is Byte; subtype Lib_Mark_Type is Byte;
-- Used in Mark_Directory -- Used in Mark_Directory
@ -698,7 +693,7 @@ package body Make is
Display_Executed_Programs : Boolean := True; Display_Executed_Programs : Boolean := True;
-- Set to True if name of commands should be output on stderr (or on stdout -- Set to True if name of commands should be output on stderr (or on stdout
-- if the Commands_To_Stdout flag was set by use of the -S switch). -- if the Commands_To_Stdout flag was set by use of the -eS switch).
Output_File_Name_Seen : Boolean := False; Output_File_Name_Seen : Boolean := False;
-- Set to True after having scanned the file_name for -- Set to True after having scanned the file_name for
@ -824,7 +819,8 @@ package body Make is
-- The path name of a mapping file specified by switch -C= -- The path name of a mapping file specified by switch -C=
procedure Delete_Mapping_Files; procedure Delete_Mapping_Files;
-- Delete all temporary mapping files -- Delete all temporary mapping files. Called only in Delete_All_Temp_Files
-- which ensures that Debug_Flag_N is False.
procedure Init_Mapping_File procedure Init_Mapping_File
(Project : Project_Id; (Project : Project_Id;
@ -834,10 +830,13 @@ package body Make is
-- the index to the name of the file in the array The_Mapping_File_Names. -- the index to the name of the file in the array The_Mapping_File_Names.
procedure Delete_Temp_Config_Files; procedure Delete_Temp_Config_Files;
-- Delete all temporary config files -- Delete all temporary config files. Must not be called if Debug_Flag_N
-- is False.
procedure Delete_All_Temp_Files; procedure Delete_All_Temp_Files;
-- Delete all temp files (config files, mapping files, path files) -- Delete all temp files (config files, mapping files, path files), unless
-- Debug_Flag_N is True (in which case all temp files are left for user
-- examination).
------------------------------------------------- -------------------------------------------------
-- Subprogram declarations moved from the spec -- -- Subprogram declarations moved from the spec --
@ -1414,7 +1413,7 @@ package body Make is
when Directory_Error => when Directory_Error =>
Make_Failed ("unable to change to object directory """ & Make_Failed ("unable to change to object directory """ &
Get_Name_String Path_Or_File_Name
(Project_Tree.Projects.Table (Project_Tree.Projects.Table
(Actual_Project).Object_Directory) & (Actual_Project).Object_Directory) &
""" of project " & """ of project " &
@ -2838,6 +2837,7 @@ package body Make is
end loop; end loop;
if The_Data.Library if The_Data.Library
and then not The_Data.Externally_Built
and then not The_Data.Need_To_Build_Lib and then not The_Data.Need_To_Build_Lib
then then
-- Add to the Q all sources of the project that -- Add to the Q all sources of the project that
@ -3487,11 +3487,10 @@ package body Make is
-- If we could not read the ALI file that was just generated -- If we could not read the ALI file that was just generated
-- then there could be a problem reading either the ALI or the -- then there could be a problem reading either the ALI or the
-- corresponding object file (if Check_Object_Consistency -- corresponding object file (if Check_Object_Consistency is
-- is set Read_Library_Info checks that the time stamp of the -- set Read_Library_Info checks that the time stamp of the
-- object file is more recent than that of the ALI). For an -- object file is more recent than that of the ALI). However,
-- example of problems caught by this test see [6625-009]. -- we record a failure only if not already done.
-- However, we record a failure only if not already done.
else else
if Compilation_OK and not Syntax_Only then if Compilation_OK and not Syntax_Only then
@ -3655,8 +3654,9 @@ package body Make is
-- Delete any temporary configuration pragma file -- Delete any temporary configuration pragma file
Delete_Temp_Config_Files; if not Debug.Debug_Flag_N then
Delete_Temp_Config_Files;
end if;
end Compile_Sources; end Compile_Sources;
----------------------------------- -----------------------------------
@ -3863,8 +3863,15 @@ package body Make is
Global_Attribute.Project); Global_Attribute.Project);
begin begin
if not Is_Regular_File (Path) then if not Is_Regular_File (Path) then
Make_Failed if Debug.Debug_Flag_F then
("cannot find configuration pragmas file ", Path); Make_Failed
("cannot find configuration pragmas file ",
File_Name (Path));
else
Make_Failed
("cannot find configuration pragmas file ",
Path);
end if;
end if; end if;
Last := Last + 1; Last := Last + 1;
@ -3901,8 +3908,15 @@ package body Make is
Local_Attribute.Project); Local_Attribute.Project);
begin begin
if not Is_Regular_File (Path) then if not Is_Regular_File (Path) then
Make_Failed if Debug.Debug_Flag_F then
("cannot find configuration pragmas file ", Path); Make_Failed
("cannot find configuration pragmas file ",
File_Name (Path));
else
Make_Failed
("cannot find configuration pragmas file ", Path);
end if;
end if; end if;
Last := Last + 1; Last := Last + 1;
@ -3945,7 +3959,7 @@ package body Make is
procedure Delete_All_Temp_Files is procedure Delete_All_Temp_Files is
begin begin
if Gnatmake_Called and not Debug.Debug_Flag_N then if not Debug.Debug_Flag_N then
Delete_Mapping_Files; Delete_Mapping_Files;
Delete_Temp_Config_Files; Delete_Temp_Config_Files;
Prj.Env.Delete_All_Path_Files (Project_Tree); Prj.Env.Delete_All_Path_Files (Project_Tree);
@ -3959,18 +3973,21 @@ package body Make is
procedure Delete_Mapping_Files is procedure Delete_Mapping_Files is
Success : Boolean; Success : Boolean;
pragma Warnings (Off, Success); pragma Warnings (Off, Success);
begin begin
if not Debug.Debug_Flag_N then -- The caller is responsible for ensuring that Debug_Flag_N is False
if The_Mapping_File_Names /= null then
for Project in The_Mapping_File_Names'Range (1) loop pragma Assert (not Debug.Debug_Flag_N);
for Index in 1 .. Last_Mapping_File_Names (Project) loop
Delete_File if The_Mapping_File_Names /= null then
(Name => Get_Name_String for Project in The_Mapping_File_Names'Range (1) loop
(The_Mapping_File_Names (Project, Index)), for Index in 1 .. Last_Mapping_File_Names (Project) loop
Success => Success); Delete_File
end loop; (Name => Get_Name_String
(The_Mapping_File_Names (Project, Index)),
Success => Success);
end loop; end loop;
end if; end loop;
end if; end if;
end Delete_Mapping_Files; end Delete_Mapping_Files;
@ -3983,7 +4000,11 @@ package body Make is
pragma Warnings (Off, Success); pragma Warnings (Off, Success);
begin begin
if (not Debug.Debug_Flag_N) and Main_Project /= No_Project then -- The caller is responsible for ensuring that Debug_Flag_N is False
pragma Assert (not Debug.Debug_Flag_N);
if Main_Project /= No_Project then
for Project in Project_Table.First .. for Project in Project_Table.First ..
Project_Table.Last (Project_Tree.Projects) Project_Table.Last (Project_Tree.Projects)
loop loop
@ -4004,10 +4025,10 @@ package body Make is
(Project).Config_File_Name), (Project).Config_File_Name),
Success => Success); Success => Success);
-- Make sure that we don't have a config file for this -- Make sure that we don't have a config file for this project,
-- project, in case when there are several mains. -- in case there are several mains. In this case, we will
-- In this case, we will recreate another config file: -- recreate another config file: we cannot reuse the one that
-- we cannot reuse the one that we just deleted! -- we just deleted!
Project_Tree.Projects.Table (Project). Project_Tree.Projects.Table (Project).
Config_Checked := False; Config_Checked := False;
@ -4069,7 +4090,40 @@ package body Make is
Args (J) (Args (J)'First .. Args (J)'First + 2) /= "-F=" Args (J) (Args (J)'First .. Args (J)'First + 2) /= "-F="
then then
Write_Str (" "); Write_Str (" ");
Write_Str (Args (J).all);
-- If -df is used, only display file names, not path
-- names.
if Debug.Debug_Flag_F then
declare
Equal_Pos : Natural;
begin
Equal_Pos := Args (J)'First - 1;
for K in Args (J)'Range loop
if Args (J) (K) = '=' then
Equal_Pos := K;
exit;
end if;
end loop;
if Is_Absolute_Path
(Args (J) (Equal_Pos + 1 .. Args (J)'Last))
then
Write_Str
(Args (J) (Args (J)'First .. Equal_Pos));
Write_Str
(File_Name
(Args (J)
(Equal_Pos + 1 .. Args (J)'Last)));
else
Write_Str (Args (J).all);
end if;
end;
else
Write_Str (Args (J).all);
end if;
end if; end if;
end if; end if;
end if; end if;
@ -4583,8 +4637,6 @@ package body Make is
-- This body is very long, should be broken down ??? -- This body is very long, should be broken down ???
begin begin
Gnatmake_Called := True;
Install_Int_Handler (Sigint_Intercepted'Access); Install_Int_Handler (Sigint_Intercepted'Access);
Do_Compile_Step := True; Do_Compile_Step := True;
@ -4716,16 +4768,12 @@ package body Make is
-- If no sources to compile, then there is nothing to do -- If no sources to compile, then there is nothing to do
if Osint.Number_Of_Files = 0 then if Osint.Number_Of_Files = 0 then
if not Debug.Debug_Flag_N then
Delete_Mapping_Files;
Prj.Env.Delete_All_Path_Files (Project_Tree);
end if;
if not Quiet_Output then if not Quiet_Output then
Osint.Write_Program_Name; Osint.Write_Program_Name;
Write_Line (": no sources to compile"); Write_Line (": no sources to compile");
end if; end if;
Delete_All_Temp_Files;
Exit_Program (E_Success); Exit_Program (E_Success);
end if; end if;
end if; end if;
@ -4875,6 +4923,8 @@ package body Make is
Gcc_Path => Gcc_Path, Gcc_Path => Gcc_Path,
Bind => Bind_Only, Bind => Bind_Only,
Link => Link_Only); Link => Link_Only);
Delete_All_Temp_Files;
Exit_Program (E_Success); Exit_Program (E_Success);
else else
@ -6490,10 +6540,7 @@ package body Make is
-- Delete the temporary mapping file that was created if we are -- Delete the temporary mapping file that was created if we are
-- using project files. -- using project files.
if not Debug.Debug_Flag_N then Delete_All_Temp_Files;
Delete_Mapping_Files;
Prj.Env.Delete_All_Path_Files (Project_Tree);
end if;
exception exception
when X : others => when X : others =>
@ -6770,6 +6817,14 @@ package body Make is
Project_File_Name => Project_File_Name.all, Project_File_Name => Project_File_Name.all,
Packages_To_Check => Packages_To_Check_By_Gnatmake); Packages_To_Check => Packages_To_Check_By_Gnatmake);
-- The parsing of project files may have changed the current output
if Commands_To_Stdout then
Set_Standard_Output;
else
Set_Standard_Error;
end if;
if Main_Project = No_Project then if Main_Project = No_Project then
Make_Failed ("""", Project_File_Name.all, """ processing failed"); Make_Failed ("""", Project_File_Name.all, """ processing failed");
end if; end if;
@ -6852,6 +6907,7 @@ package body Make is
Put_In_Q : Boolean := Into_Q; Put_In_Q : Boolean := Into_Q;
Unit : Unit_Data; Unit : Unit_Data;
Sfile : File_Name_Type; Sfile : File_Name_Type;
Index : Int;
Extending : constant Boolean := Extending : constant Boolean :=
Project_Tree.Projects.Table Project_Tree.Projects.Table
@ -6899,6 +6955,7 @@ package body Make is
loop loop
Unit := Project_Tree.Units.Table (Id); Unit := Project_Tree.Units.Table (Id);
Sfile := No_File; Sfile := No_File;
Index := 0;
-- If there is a source for the body, and the body has not been -- If there is a source for the body, and the body has not been
-- locally removed, -- locally removed,
@ -6937,13 +6994,16 @@ package body Make is
if Sinput.P.Source_File_Is_Subunit (Src_Ind) then if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
Sfile := No_File; Sfile := No_File;
Index := 0;
else else
Sfile := Unit.File_Names (Body_Part).Display_Name; Sfile := Unit.File_Names (Body_Part).Display_Name;
Index := Unit.File_Names (Body_Part).Index;
end if; end if;
end; end;
else else
Sfile := Unit.File_Names (Body_Part).Display_Name; Sfile := Unit.File_Names (Body_Part).Display_Name;
Index := Unit.File_Names (Body_Part).Index;
end if; end if;
end if; end if;
@ -6956,6 +7016,7 @@ package body Make is
-- this one. -- this one.
Sfile := Unit.File_Names (Specification).Display_Name; Sfile := Unit.File_Names (Specification).Display_Name;
Index := Unit.File_Names (Specification).Index;
end if; end if;
-- If Put_In_Q is True, we insert into the Q -- If Put_In_Q is True, we insert into the Q
@ -6972,15 +7033,15 @@ package body Make is
-- And of course, we only insert in the Q if the source is not -- And of course, we only insert in the Q if the source is not
-- marked. -- marked.
if Sfile /= No_File and then not Is_Marked (Sfile) then if Sfile /= No_File and then not Is_Marked (Sfile, Index) then
if Verbose_Mode then if Verbose_Mode then
Write_Str ("Adding """); Write_Str ("Adding """);
Write_Str (Get_Name_String (Sfile)); Write_Str (Get_Name_String (Sfile));
Write_Line (""" to the queue"); Write_Line (""" to the queue");
end if; end if;
Insert_Q (Sfile); Insert_Q (Sfile, Index => Index);
Mark (Sfile); Mark (Sfile, Index);
end if; end if;
elsif Sfile /= No_File then elsif Sfile /= No_File then
@ -6996,7 +7057,7 @@ package body Make is
Write_Line (""" as if on the command line"); Write_Line (""" as if on the command line");
end if; end if;
Osint.Add_File (Get_Name_String (Sfile)); Osint.Add_File (Get_Name_String (Sfile), Index);
Put_In_Q := True; Put_In_Q := True;
-- As we may look into the Q later, ensure the Q has been -- As we may look into the Q later, ensure the Q has been
@ -7404,11 +7465,7 @@ package body Make is
procedure Report_Compilation_Failed is procedure Report_Compilation_Failed is
begin begin
if not Debug.Debug_Flag_N then Delete_All_Temp_Files;
Delete_Mapping_Files;
Prj.Env.Delete_All_Path_Files (Project_Tree);
end if;
Exit_Program (E_Fatal); Exit_Program (E_Fatal);
end Report_Compilation_Failed; end Report_Compilation_Failed;
@ -7421,7 +7478,6 @@ package body Make is
begin begin
Set_Standard_Error; Set_Standard_Error;
Write_Line ("*** Interrupted ***"); Write_Line ("*** Interrupted ***");
Delete_All_Temp_Files;
-- Send SIGINT to all outstanding compilation processes spawned -- Send SIGINT to all outstanding compilation processes spawned
@ -7429,7 +7485,10 @@ package body Make is
Kill (Running_Compile (J).Pid, SIGINT, 1); Kill (Running_Compile (J).Pid, SIGINT, 1);
end loop; end loop;
Delete_All_Temp_Files;
OS_Exit (1); OS_Exit (1);
-- ??? OS_Exit (1) is equivalent to Exit_Program (E_No_Compile),
-- shouldn't that be Exit_Program (E_Abort) instead?
end Sigint_Intercepted; end Sigint_Intercepted;
------------------- -------------------

5
gcc/ada/makeutl.ads
View File

@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004-2007, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2008, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -130,6 +130,9 @@ package Makeutl is
-- For gnatbind switches, Including_L_Switch is False, because the -- For gnatbind switches, Including_L_Switch is False, because the
-- argument of the -L switch is not a path. -- argument of the -L switch is not a path.
function Path_Or_File_Name (Path : Path_Name_Type) return String;
-- Returns a file name if -df is used, otherwise return a path name
---------------------- ----------------------
-- Marking Routines -- -- Marking Routines --
---------------------- ----------------------