Browse Source

--- Merging r22980 into '.':
U packages/fpmkunit/src/fpmkunit.pp
--- Merging r24724 into '.':
G packages/fpmkunit/src/fpmkunit.pp
--- Merging r25339 into '.':
G packages/fpmkunit/src/fpmkunit.pp

# revisions: 22980,24724,25339
r22980 | joost | 2012-11-11 22:28:29 +0100 (Sun, 11 Nov 2012) | 1 line
Changed paths:
M /trunk/packages/fpmkunit/src/fpmkunit.pp

* Make distclean should clean up for all known targets. This behavior waw broken since r18060
r24724 | joost | 2013-06-01 17:00:35 +0200 (Sat, 01 Jun 2013) | 2 lines
Changed paths:
M /trunk/packages/fpmkunit/src/fpmkunit.pp

* Improved verbose and debug output while removing files
* Do not try to remove directories for cpuNone and osNone
r25339 | karoly | 2013-08-23 15:25:44 +0200 (Fri, 23 Aug 2013) | 3 lines
Changed paths:
M /trunk/packages/fpmkunit/src/fpmkunit.pp

don't try to clean unsupported CPU-OS combinations
* greatly enhances clean performance over FSes with limited to no caching (networked file systems (eg. SSHFS), Amiga, etc)
* also an indentation fix

git-svn-id: branches/fixes_2_6@26844 -

marco 11 years ago
parent
commit
58952e018d
1 changed files with 39 additions and 17 deletions
  1. 39 17
      packages/fpmkunit/src/fpmkunit.pp

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

@@ -1315,7 +1315,8 @@ ResourceString
   SInfoCleaningPackage    = 'Cleaning package %s';
   SInfoCleaningPackage    = 'Cleaning package %s';
   SInfoManifestPackage    = 'Creating manifest for package %s';
   SInfoManifestPackage    = 'Creating manifest for package %s';
   SInfoCopyingFile        = 'Copying file "%s" to "%s"';
   SInfoCopyingFile        = 'Copying file "%s" to "%s"';
-  SInfoDeletingFile       = 'Deleting file "%s"';
+  SInfoDeletedFile        = 'Deleted file "%s"';
+  SInfoRemovedDirectory   = 'Removed directory "%s"';
   SInfoSourceNewerDest    = 'Source file "%s" (%s) is newer than destination "%s" (%s).';
   SInfoSourceNewerDest    = 'Source file "%s" (%s) is newer than destination "%s" (%s).';
   SInfoDestDoesNotExist   = 'Destination file "%s" does not exist.';
   SInfoDestDoesNotExist   = 'Destination file "%s" does not exist.';
   SInfoFallbackBuildmode  = 'Buildmode not supported by package, falling back to one by one unit compilation';
   SInfoFallbackBuildmode  = 'Buildmode not supported by package, falling back to one by one unit compilation';
@@ -1354,6 +1355,9 @@ ResourceString
   SDbgDirectoryDoesNotExist = 'Directory "%s" does not exist';
   SDbgDirectoryDoesNotExist = 'Directory "%s" does not exist';
   SDbgDirectoryNotEmpty     = 'Directory "%s" is not empty. Will not remove';
   SDbgDirectoryNotEmpty     = 'Directory "%s" is not empty. Will not remove';
   SDbgGenerateBuildUnit     = 'Generate build-unit %s';
   SDbgGenerateBuildUnit     = 'Generate build-unit %s';
+  SDbgDeletedFile           = 'Recursively deleted file "%s"';
+  SDbgRemovedDirectory      = 'Recursively removed directory "%s"';
+
 
 
   // Help messages for usage
   // Help messages for usage
   SValue              = 'Value';
   SValue              = 'Value';
@@ -4417,11 +4421,12 @@ end;
 
 
 procedure TBuildEngine.SysDeleteFile(Const AFileName : String);
 procedure TBuildEngine.SysDeleteFile(Const AFileName : String);
 begin
 begin
-  Log(vlInfo,SInfoDeletingFile,[AFileName]);
   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 DeleteFile(AFileName) then
-    Error(SErrDeletingFile,[AFileName]);
+    Error(SErrDeletingFile,[AFileName])
+  else
+    Log(vlInfo,SInfoDeletedFile,[AFileName]);
 end;
 end;
 
 
 procedure TBuildEngine.SysDeleteDirectory(Const ADirectoryName: String);
 procedure TBuildEngine.SysDeleteDirectory(Const ADirectoryName: String);
@@ -4431,7 +4436,9 @@ begin
   else if not IsDirectoryEmpty(ADirectoryName) then
   else if not IsDirectoryEmpty(ADirectoryName) then
     Log(vldebug,SDbgDirectoryNotEmpty,[ADirectoryName])
     Log(vldebug,SDbgDirectoryNotEmpty,[ADirectoryName])
   else If Not RemoveDir(ADirectoryName) then
   else If Not RemoveDir(ADirectoryName) then
-    Error(SErrRemovingDirectory,[ADirectoryName]);
+    Error(SErrRemovingDirectory,[ADirectoryName])
+  else
+    Log(vlInfo,SInfoRemovedDirectory,[ADirectoryName]);
 end;
 end;
 
 
 
 
@@ -4441,6 +4448,7 @@ procedure TBuildEngine.SysDeleteTree(Const ADirectoryName: String);
   var
   var
     searchRec: TSearchRec;
     searchRec: TSearchRec;
     SearchResult: longint;
     SearchResult: longint;
+    s: string;
   begin
   begin
     result := true;
     result := true;
     SearchResult := FindFirst(IncludeTrailingPathDelimiter(ADirectoryName)+AllFilesMask, faAnyFile+faSymLink, searchRec);
     SearchResult := FindFirst(IncludeTrailingPathDelimiter(ADirectoryName)+AllFilesMask, faAnyFile+faSymLink, searchRec);
@@ -4449,13 +4457,16 @@ procedure TBuildEngine.SysDeleteTree(Const ADirectoryName: String);
         begin
         begin
           if (searchRec.Name<>'.') and (searchRec.Name<>'..') then
           if (searchRec.Name<>'.') and (searchRec.Name<>'..') then
              begin
              begin
+               s := IncludeTrailingPathDelimiter(ADirectoryName)+searchRec.Name;
                if (searchRec.Attr and faDirectory)=faDirectory then
                if (searchRec.Attr and faDirectory)=faDirectory then
                  begin
                  begin
-                   if not IntRemoveTree(IncludeTrailingPathDelimiter(ADirectoryName)+searchRec.Name) then
+                   if not IntRemoveTree(s) then
                      result := false;
                      result := false;
                  end
                  end
-               else if not DeleteFile(IncludeTrailingPathDelimiter(ADirectoryName)+searchRec.Name) then
-                 result := False;
+               else if not DeleteFile(s) then
+                 result := False
+               else
+                 log(vldebug, SDbgDeletedFile, [s]);
              end;
              end;
           SearchResult := FindNext(searchRec);
           SearchResult := FindNext(searchRec);
         end;
         end;
@@ -4463,14 +4474,18 @@ procedure TBuildEngine.SysDeleteTree(Const ADirectoryName: String);
       FindClose(searchRec);
       FindClose(searchRec);
     end;
     end;
     if not RemoveDir(ADirectoryName) then
     if not RemoveDir(ADirectoryName) then
-      result := false;
+      result := false
+    else
+      log(vldebug, SDbgRemovedDirectory, [ADirectoryName]);
   end;
   end;
 
 
 begin
 begin
   if not DirectoryExists(ADirectoryName) then
   if not DirectoryExists(ADirectoryName) then
     Log(vldebug,SDbgDirectoryDoesNotExist,[ADirectoryName])
     Log(vldebug,SDbgDirectoryDoesNotExist,[ADirectoryName])
   else If Not IntRemoveTree(ADirectoryName) then
   else If Not IntRemoveTree(ADirectoryName) then
-    Error(SErrRemovingDirectory,[ADirectoryName]);
+    Error(SErrRemovingDirectory,[ADirectoryName])
+  else
+    Log(vlInfo,SInfoRemovedDirectory,[ADirectoryName]);
 end;
 end;
 
 
 
 
@@ -6146,8 +6161,8 @@ end;
 
 
 procedure TBuildEngine.Clean(APackage: TPackage; AllTargets: boolean);
 procedure TBuildEngine.Clean(APackage: TPackage; AllTargets: boolean);
 var
 var
-//  ACPU: TCpu;
-//  AOS: TOS;
+  ACPU: TCpu;
+  AOS: TOS;
   DirectoryList : TStringList;
   DirectoryList : TStringList;
 begin
 begin
   Log(vlInfo,SInfoCleaningPackage,[APackage.Name]);
   Log(vlInfo,SInfoCleaningPackage,[APackage.Name]);
@@ -6161,8 +6176,15 @@ begin
         // being renamed and such. See also bug 19655
         // being renamed and such. See also bug 19655
         DirectoryList := TStringList.Create;
         DirectoryList := TStringList.Create;
         try
         try
-          DirectoryList.Add(ExtractFileDir(APackage.GetUnitsOutputDir(Defaults.CPU,Defaults.OS)));
-          DirectoryList.Add(ExtractFileDir(APackage.GetBinOutputDir(Defaults.CPU,Defaults.OS)));
+          for ACPU:=low(TCpu) to high(TCpu) do if ACPU<>cpuNone then
+            for AOS:=low(TOS) to high(TOS) do if AOS<>osNone then
+              begin
+                if OSCPUSupported[AOS,ACPU] then
+                  begin
+                    DirectoryList.Add(ExtractFileDir(APackage.GetUnitsOutputDir(ACPU,AOS)));
+                    DirectoryList.Add(ExtractFileDir(APackage.GetBinOutputDir(ACPU,AOS)));
+                  end;
+              end;
           CmdRemoveTrees(DirectoryList);
           CmdRemoveTrees(DirectoryList);
         finally
         finally
           DirectoryList.Free;
           DirectoryList.Free;
@@ -6464,10 +6486,10 @@ begin
   Log(vldebug, SDbgBuildEngineCleaning);
   Log(vldebug, SDbgBuildEngineCleaning);
   For I:=0 to Packages.Count-1 do
   For I:=0 to Packages.Count-1 do
     begin
     begin
-    P:=Packages.PackageItems[i];
-    If AllTargets or PackageOK(P) then
-      Clean(P, AllTargets);
-    log(vlWarning, SWarnCleanPackagecomplete, [P.Name]);
+      P:=Packages.PackageItems[i];
+      If AllTargets or PackageOK(P) then
+        Clean(P, AllTargets);
+      log(vlWarning, SWarnCleanPackagecomplete, [P.Name]);
     end;
     end;
   If Assigned(AfterClean) then
   If Assigned(AfterClean) then
     AfterClean(Self);
     AfterClean(Self);