mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-15 00:09:26 +02:00
* add similar retries to sysdeletefile as for removedirs.
because buildunits sometimes fail to erase. Seems to fix #21868 git-svn-id: trunk@40520 -
This commit is contained in:
parent
b0d7ba7e6f
commit
c32c6c4cd6
@ -1683,6 +1683,7 @@ ResourceString
|
|||||||
SWarngcclibpath = 'Warning: Unable to determine the libgcc path.';
|
SWarngcclibpath = 'Warning: Unable to determine the libgcc path.';
|
||||||
SWarnNoFCLProcessSupport= 'No FCL-Process support';
|
SWarnNoFCLProcessSupport= 'No FCL-Process support';
|
||||||
SWarnRetryRemDirectory = 'Failed to remove directory "%s". Retry after a short delay';
|
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';
|
SWarnCombinedPathAndUDir= 'Warning: Better do not combine the SearchPath and Global/Local-UnitDir parameters';
|
||||||
SWarnRemovedNonEmptyDirectory = 'Warning: Removed non empty directory "%s"';
|
SWarnRemovedNonEmptyDirectory = 'Warning: Removed non empty directory "%s"';
|
||||||
|
|
||||||
@ -5831,13 +5832,27 @@ end;
|
|||||||
|
|
||||||
|
|
||||||
procedure TBuildEngine.SysDeleteFile(Const AFileName : String);
|
procedure TBuildEngine.SysDeleteFile(Const AFileName : String);
|
||||||
|
var retries : integer;
|
||||||
|
res : boolean;
|
||||||
begin
|
begin
|
||||||
if not FileExists(AFileName) then
|
if not FileExists(AFileName) then
|
||||||
Log(vldebug,SDbgFileDoesNotExist,[AFileName])
|
Log(vldebug,SDbgFileDoesNotExist,[AFileName])
|
||||||
else If Not SysUtils.DeleteFile(AFileName) then
|
|
||||||
Error(SErrDeletingFile,[AFileName])
|
|
||||||
else
|
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;
|
end;
|
||||||
|
|
||||||
procedure TBuildEngine.SysDeleteDirectory(Const ADirectoryName: String);
|
procedure TBuildEngine.SysDeleteDirectory(Const ADirectoryName: String);
|
||||||
|
Loading…
Reference in New Issue
Block a user