Browse Source

* When the removal of a directory fails during a recursive
SysDeleteTree, wait 5 seconds and retry twice. Hopefully this solves bug #21868

git-svn-id: trunk@29206 -

joost 10 years ago
parent
commit
ab3fc89698
1 changed files with 17 additions and 3 deletions
  1. 17 3
      packages/fpmkunit/src/fpmkunit.pp

+ 17 - 3
packages/fpmkunit/src/fpmkunit.pp

@@ -1526,6 +1526,7 @@ ResourceString
   SWarngccNotFound        = 'Could not find libgcc';
   SWarngccNotFound        = 'Could not find libgcc';
   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';
 
 
   SInfoPackageAlreadyProcessed = 'Package %s is already processed';
   SInfoPackageAlreadyProcessed = 'Package %s is already processed';
   SInfoCompilingTarget    = 'Compiling target %s';
   SInfoCompilingTarget    = 'Compiling target %s';
@@ -5049,6 +5050,7 @@ procedure TBuildEngine.SysDeleteTree(Const ADirectoryName: String);
     searchRec: TSearchRec;
     searchRec: TSearchRec;
     SearchResult: longint;
     SearchResult: longint;
     s: string;
     s: string;
+    i: integer;
   begin
   begin
     result := true;
     result := true;
     SearchResult := FindFirst(IncludeTrailingPathDelimiter(ADirectoryName)+AllFilesMask, faAnyFile+faSymLink, searchRec);
     SearchResult := FindFirst(IncludeTrailingPathDelimiter(ADirectoryName)+AllFilesMask, faAnyFile+faSymLink, searchRec);
@@ -5073,9 +5075,21 @@ procedure TBuildEngine.SysDeleteTree(Const ADirectoryName: String);
     finally
     finally
       FindClose(searchRec);
       FindClose(searchRec);
     end;
     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]);
       log(vldebug, SDbgRemovedDirectory, [ADirectoryName]);
   end;
   end;