Browse Source

* Use the windows-api instead of findfirst/findnext to remove a full path. The latter
seems to have some locking issues. See bug #21868.

git-svn-id: trunk@29284 -

joost 11 years ago
parent
commit
2d4511101d
1 changed files with 37 additions and 10 deletions
  1. 37 10
      packages/fpmkunit/src/fpmkunit.pp

+ 37 - 10
packages/fpmkunit/src/fpmkunit.pp

@@ -81,6 +81,9 @@ uses
 {$ifdef UNIX}
 {$ifdef UNIX}
   cthreads,
   cthreads,
 {$endif UNIX}
 {$endif UNIX}
+{$ifdef WINDOWS}
+  windows, ShellApi,
+{$endif WINDOWS}
 {$endif NO_THREADING}
 {$endif NO_THREADING}
   SysUtils, Classes
   SysUtils, Classes
 {$ifdef HAS_UNIT_PROCESS}
 {$ifdef HAS_UNIT_PROCESS}
@@ -1846,7 +1849,7 @@ begin
         SearchResult := FindNext(searchRec);
         SearchResult := FindNext(searchRec);
       end;
       end;
   finally
   finally
-    FindClose(searchRec);
+    sysutils.FindClose(searchRec);
   end;
   end;
 end;
 end;
 
 
@@ -2366,7 +2369,7 @@ procedure SearchFiles(const AFileName: string; Recursive: boolean; var List: TSt
             List.Add(SearchDir + Info.Name);
             List.Add(SearchDir + Info.Name);
       until FindNext(Info)<>0;
       until FindNext(Info)<>0;
     end;
     end;
-    FindClose(Info);
+    sysutils.FindClose(Info);
   end;
   end;
 
 
 var
 var
@@ -2555,7 +2558,7 @@ function GetDefaultLibGCCDir(CPU : TCPU;OS: TOS; var ErrorMessage: string): stri
       GccExecutable: string;
       GccExecutable: string;
   begin
   begin
     result := '';
     result := '';
-    GccExecutable := ExeSearch(AddProgramExtension('gcc', OS),GetEnvironmentVariable('PATH'));
+    GccExecutable := ExeSearch(AddProgramExtension('gcc', OS),Sysutils.GetEnvironmentVariable('PATH'));
     if FileExists(GccExecutable) then
     if FileExists(GccExecutable) then
       begin
       begin
 {$ifdef HAS_UNIT_PROCESS}
 {$ifdef HAS_UNIT_PROCESS}
@@ -4133,7 +4136,7 @@ begin
   If (FN='') then
   If (FN='') then
     begin
     begin
     // Environment variable.
     // Environment variable.
-    FN:=GetEnvironmentVariable('FPMAKECFG');
+    FN:=SysUtils.GetEnvironmentVariable('FPMAKECFG');
     If (FN<>'') then
     If (FN<>'') then
       If not FileExists(FN) then
       If not FileExists(FN) then
         FN:='';
         FN:='';
@@ -4349,7 +4352,7 @@ begin
         BD:='/usr/lib/fpc/'+FCompilerVersion;
         BD:='/usr/lib/fpc/'+FCompilerVersion;
     end;
     end;
 {$else unix}
 {$else unix}
-  BD:=FixPath(GetEnvironmentVariable('FPCDIR'), False);
+  BD:=FixPath(SysUtils.GetEnvironmentVariable('FPCDIR'), False);
   if BD='' then
   if BD='' then
     begin
     begin
       BD:=ExtractFilePath(FCompiler)+'..';
       BD:=ExtractFilePath(FCompiler)+'..';
@@ -5119,7 +5122,7 @@ procedure TBuildEngine.SysDeleteFile(Const AFileName : String);
 begin
 begin
   if not FileExists(AFileName) then
   if not FileExists(AFileName) then
     Log(vldebug,SDbgFileDoesNotExist,[AFileName])
     Log(vldebug,SDbgFileDoesNotExist,[AFileName])
-  else If Not DeleteFile(AFileName) then
+  else If Not SysUtils.DeleteFile(AFileName) then
     Error(SErrDeletingFile,[AFileName])
     Error(SErrDeletingFile,[AFileName])
   else
   else
     Log(vlInfo,SInfoDeletedFile,[AFileName]);
     Log(vlInfo,SInfoDeletedFile,[AFileName]);
@@ -5142,12 +5145,34 @@ procedure TBuildEngine.SysDeleteTree(Const ADirectoryName: String);
 
 
   function IntRemoveTree(const ADirectoryName: String) : boolean;
   function IntRemoveTree(const ADirectoryName: String) : boolean;
   var
   var
+    i: integer;
+{$ifdef WINDOWS}
+    SHFileOpStruct: TSHFileOpStruct;
+    DirBuf: array[0..MAX_PATH+1] of TCHAR;
+{$else WINDOWS}
     searchRec: TSearchRec;
     searchRec: TSearchRec;
     SearchResult: longint;
     SearchResult: longint;
     s: string;
     s: string;
-    i: integer;
+{$endif WINDOWS}
+
   begin
   begin
     result := true;
     result := true;
+{$ifdef WINDOWS}
+    try
+      FillChar(SHFileOpStruct, Sizeof(SHFileOpStruct), 0);
+      FillChar(DirBuf, Sizeof(DirBuf), 0);
+      StrPCopy(DirBuf, ADirectoryName);
+      with SHFileOpStruct do
+      begin
+        pFrom := @DirBuf;
+        wFunc := FO_DELETE;
+        fFlags := FOF_NOCONFIRMATION or FOF_SILENT;
+      end;
+      Result := SHFileOperation(SHFileOpStruct) = 0;
+    except
+      Result := False;
+    end;
+{$else WINDOWS}
     SearchResult := FindFirst(IncludeTrailingPathDelimiter(ADirectoryName)+AllFilesMask, faAnyFile+faSymLink, searchRec);
     SearchResult := FindFirst(IncludeTrailingPathDelimiter(ADirectoryName)+AllFilesMask, faAnyFile+faSymLink, searchRec);
     try
     try
       while SearchResult=0 do
       while SearchResult=0 do
@@ -5176,6 +5201,8 @@ procedure TBuildEngine.SysDeleteTree(Const ADirectoryName: String);
     // bug 21868
     // bug 21868
     i := 2;
     i := 2;
     result := RemoveDir(ADirectoryName);
     result := RemoveDir(ADirectoryName);
+{$endif WINDOWS}
+
     while not result and (i>0) do
     while not result and (i>0) do
       begin
       begin
         log(vlWarning, SWarnRetryRemDirectory, [ADirectoryName]);
         log(vlWarning, SWarnRetryRemDirectory, [ADirectoryName]);
@@ -5459,7 +5486,7 @@ begin
 
 
           Cmd:=C.Command;
           Cmd:=C.Command;
           If (ExtractFilePath(Cmd)='') then
           If (ExtractFilePath(Cmd)='') then
-            Cmd:=ExeSearch(Cmd,GetEnvironmentvariable('PATH'));
+            Cmd:=ExeSearch(Cmd,SysUtils.GetEnvironmentvariable('PATH'));
 
 
           If (SourceFile<>'') and (DestFile<>'')  then
           If (SourceFile<>'') and (DestFile<>'')  then
             begin
             begin
@@ -5990,7 +6017,7 @@ begin
     FCompiler:=Defaults.Compiler;
     FCompiler:=Defaults.Compiler;
     If (ExtractFilePath(FCompiler)='') then
     If (ExtractFilePath(FCompiler)='') then
       begin
       begin
-      S:=ExeSearch(FCompiler,GetEnvironmentVariable('PATH'));
+      S:=ExeSearch(FCompiler,SysUtils.GetEnvironmentVariable('PATH'));
       If (S<>'') then
       If (S<>'') then
          FCompiler:=S;
          FCompiler:=S;
       end;
       end;
@@ -6684,7 +6711,7 @@ begin
           end;
           end;
 
 
           //execute fpdoc
           //execute fpdoc
-          Cmd:=ExeSearch('fpdoc',GetEnvironmentvariable('PATH'));
+          Cmd:=ExeSearch('fpdoc',SysUtils.GetEnvironmentvariable('PATH'));
           if Cmd = '' then Cmd := 'fpdoc';
           if Cmd = '' then Cmd := 'fpdoc';
           ExecuteProcess(Cmd, sFPDocFormat + cmdOpts);
           ExecuteProcess(Cmd, sFPDocFormat + cmdOpts);
         end;
         end;