From c32c6c4cd64158bee964e8c94f0cf711ec4071cc Mon Sep 17 00:00:00 2001 From: marco Date: Mon, 10 Dec 2018 22:42:52 +0000 Subject: [PATCH] * add similar retries to sysdeletefile as for removedirs. because buildunits sometimes fail to erase. Seems to fix #21868 git-svn-id: trunk@40520 - --- packages/fpmkunit/src/fpmkunit.pp | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/packages/fpmkunit/src/fpmkunit.pp b/packages/fpmkunit/src/fpmkunit.pp index d53a6fa0da..a930bd4be0 100644 --- a/packages/fpmkunit/src/fpmkunit.pp +++ b/packages/fpmkunit/src/fpmkunit.pp @@ -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);