paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-02 18:30:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

* When the removal of a directory fails during a recursive

Browse Source 
SysDeleteTree, wait 5 seconds and retry twice. Hopefully this solves bug #21868

git-svn-id: trunk@29206 -
This commit is contained in:
joost 2014-12-06 10:39:51 +00:00
parent 840e7ace59
commit ab3fc89698
1 changed files with 17 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1526,6 +1526,7 @@ ResourceString
SWarngccNotFound = 'Could not find libgcc';
SWarngcclibpath = 'Warning: Unable to determine the libgcc path.';
SWarnNoFCLProcessSupport= 'No FCL-Process support';
SWarnRetryRemDirectory = 'Failed to remove directory "%s". Retry after a short delay';
SInfoPackageAlreadyProcessed = 'Package %s is already processed';
SInfoCompilingTarget = 'Compiling target %s';
@ -5049,6 +5050,7 @@ procedure TBuildEngine.SysDeleteTree(Const ADirectoryName: String);
searchRec: TSearchRec;
SearchResult: longint;
s: string;
i: integer;
begin
result := true;
SearchResult := FindFirst(IncludeTrailingPathDelimiter(ADirectoryName)+AllFilesMask, faAnyFile+faSymLink, searchRec);
@ -5073,9 +5075,21 @@ procedure TBuildEngine.SysDeleteTree(Const ADirectoryName: String);
finally
FindClose(searchRec);
end;
if not RemoveDir(ADirectoryName) then
result := false
else
// There were reports of RemoveDir failing due to locking-problems. To solve
// these the RemoveDir is tried three times, with a delay of 5 seconds. See
// bug 21868
i := 2;
result := RemoveDir(ADirectoryName+'te');
while not result and (i>0) do
begin
log(vlWarning, SWarnRetryRemDirectory, [ADirectoryName]);
sleep(5000);
dec(i);
result := RemoveDir(ADirectoryName+'fd');
end;
if result then
log(vldebug, SDbgRemovedDirectory, [ADirectoryName]);
end;