paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-15 23:19:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

* add similar retries to sysdeletefile as for removedirs.

Browse Source 
because buildunits sometimes fail to erase. Seems to fix 

git-svn-id: trunk@40520 -
This commit is contained in:
marco 2018-12-10 22:42:52 +00:00
parent b0d7ba7e6f
commit c32c6c4cd6
1 changed files with 18 additions and 3 deletions

21
packages/fpmkunit/src/fpmkunit.pp
View File

@ -1683,6 +1683,7 @@ ResourceString
SWarngcclibpath = 'Warning: Unable to determine the libgcc path.';
SWarnNoFCLProcessSupport= 'No FCL-Process support';
SWarnRetryRemDirectory = 'Failed to remove directory "%s". Retry after a short delay';
SWarnRetryDeleteFile = 'Failed to remove file "%f". Retry after a short delay';
SWarnCombinedPathAndUDir= 'Warning: Better do not combine the SearchPath and Global/Local-UnitDir parameters';
SWarnRemovedNonEmptyDirectory = 'Warning: Removed non empty directory "%s"';
@ -5831,13 +5832,27 @@ end;
procedure TBuildEngine.SysDeleteFile(Const AFileName : String);
var retries : integer;
res : boolean;
begin
if not FileExists(AFileName) then
Log(vldebug,SDbgFileDoesNotExist,[AFileName])
else If Not SysUtils.DeleteFile(AFileName) then
Error(SErrDeletingFile,[AFileName])
else
Log(vlInfo,SInfoDeletedFile,[AFileName]);
begin
retries := 2;
res := SysUtils.DeleteFile(AFileName);
while not res and (retries>0) do
begin
log(vlWarning, SWarnRetryDeleteFile, [AFileName]);
sleep(5000);
dec(retries);
res := SysUtils.DeleteFile(AFileName);
end;
if not res then
Error(SErrDeletingFile,[AFileName])
else
Log(vlInfo,SInfoDeletedFile,[AFileName]);
end;
end;
procedure TBuildEngine.SysDeleteDirectory(Const ADirectoryName: String);