From 7bcf71f342294a68c413c55842601433cdac704f Mon Sep 17 00:00:00 2001 From: joost Date: Mon, 1 Aug 2011 20:29:22 +0000 Subject: [PATCH] * Remove the unit-directory entirely on a distclean. To avoid problems when units got renamed, or in similar circumstances git-svn-id: trunk@18055 - --- packages/fpmkunit/src/fpmkunit.pp | 75 ++++++++++++++++++++++++++++++- 1 file changed, 73 insertions(+), 2 deletions(-) diff --git a/packages/fpmkunit/src/fpmkunit.pp b/packages/fpmkunit/src/fpmkunit.pp index 874249bdb3..327a82738d 100644 --- a/packages/fpmkunit/src/fpmkunit.pp +++ b/packages/fpmkunit/src/fpmkunit.pp @@ -695,6 +695,7 @@ Type FBinInstallDir, FDocInstallDir, FExamplesInstallDir : String; + FRemoveTree: String; FRemoveDir: String; FRemove: String; FTarget: String; @@ -755,6 +756,7 @@ Type Property Move : String Read FMove Write FMove; // Move $(FILES) to $(DEST) Property Remove : String Read FRemove Write FRemove; // Delete $(FILES) Property RemoveDir : String Read FRemoveDir Write FRemoveDir; // Delete $(FILES) + Property RemoveTree : String Read FRemoveTree Write FRemoveTree; // removes $(DIRECTORY) Property MkDir : String Read FMkDir write FMkDir; // Make $(DIRECTORY) Property Archive : String Read FArchive Write FArchive; // zip $(ARCHIVE) $(FILESORDIRS) // Misc @@ -811,6 +813,7 @@ Type Procedure SysMoveFile(Const Src,Dest : String); virtual; Procedure SysDeleteFile(Const AFileName : String); virtual; Procedure SysDeleteDirectory(Const ADirectoryName : String); virtual; + Procedure SysDeleteTree(Const ADirectoryName : String); virtual; Procedure SysArchiveFiles(List : TStrings; Const AFileName : String); virtual; procedure LogIndent; procedure LogUnIndent; @@ -846,6 +849,7 @@ Type Procedure CmdArchiveFiles(List : TStrings; Const ArchiveFile : String); Procedure CmdRenameFile(SourceName, DestName : String); Procedure CmdRemoveDirs(List: TStrings); + Procedure CmdRemoveTrees(List: TStrings); Procedure ExecuteCommands(Commands : TCommands; At : TCommandAt); // Dependency commands Function DependencyOK(ADependency : TDependency) : Boolean; @@ -1174,6 +1178,7 @@ Const KeyMove = 'Move'; KeyRemove = 'Remove'; KeyRemoveDir= 'RemoveDir'; + KeyRemoveTree= 'RemoveTree'; KeyOptions = 'Options'; KeyCPU = 'CPU'; KeyOS = 'OS'; @@ -3035,6 +3040,7 @@ begin Values[KeyExamplesInstallDir]:=FExamplesInstallDir; Values[KeyRemove]:=FRemove; Values[KeyRemoveDir]:=FRemoveDir; + Values[KeyRemoveTree]:=FRemoveTree; Values[KeyTarget]:=FTarget; if FNoFPCCfg then Values[KeyNoFPCCfg]:='Y'; @@ -3075,6 +3081,7 @@ begin FMove:=Values[KeyMove]; FRemove:=Values[KeyRemove]; FRemoveDir:=Values[KeyRemoveDir]; + FRemoveTree:=Values[KeyRemoveTree]; Options:=OptionsToStringList(Values[KeyOptions]); Line:=Values[KeyCPU]; If (Line<>'') then @@ -3698,6 +3705,45 @@ begin end; +procedure TBuildEngine.SysDeleteTree(const ADirectoryName: String); + + function IntRemoveTree(const ADirectoryName: String) : boolean; + var + searchRec: TSearchRec; + SearchResult: longint; + begin + result := true; + SearchResult := FindFirst(IncludeTrailingPathDelimiter(ADirectoryName)+AllFilesMask, faAnyFile+faSymLink, searchRec); + try + while SearchResult=0 do + begin + if (searchRec.Name<>'.') and (searchRec.Name<>'..') then + begin + if (searchRec.Attr and faDirectory)=faDirectory then + begin + if not IntRemoveTree(IncludeTrailingPathDelimiter(ADirectoryName)+searchRec.Name) then + result := false; + end + else if not DeleteFile(IncludeTrailingPathDelimiter(ADirectoryName)+searchRec.Name) then + result := False; + end; + SearchResult := FindNext(searchRec); + end; + finally + FindClose(searchRec); + end; + if not RemoveDir(ADirectoryName) then + result := false; + end; + +begin + if not DirectoryExists(ADirectoryName) then + Log(vldebug,SDbgDirectoryDoesNotExist,[ADirectoryName]) + else If Not IntRemoveTree(ADirectoryName) then + Error(SErrRemovingDirectory,[ADirectoryName]); +end; + + procedure TBuildEngine.SysArchiveFiles(List: TStrings;Const AFileName: String); begin If Not (Assigned(OnArchivefiles) or Assigned(ArchiveFilesProc)) then @@ -3873,6 +3919,21 @@ begin SysDeleteDirectory(List[i]); end; +procedure TBuildEngine.CmdRemoveTrees(List: TStrings); +Var + Args : String; + I : Integer; +begin + If (Defaults.RemoveTree<>'') then + begin + Args:=FileListToString(List,''); + ExecuteCommand(Defaults.RemoveTree,Args); + end + else + For I:=0 to List.Count-1 do + SysDeleteTree(List[i]); +end; + Function TBuildEngine.FileNewer(const Src,Dest : String) : Boolean; Var @@ -5026,6 +5087,7 @@ procedure TBuildEngine.Clean(APackage: TPackage; AllTargets: boolean); var ACPU: TCpu; AOS: TOS; + DirectoryList : TStringList; begin Log(vlInfo,SInfoCleaningPackage,[APackage.Name]); try @@ -5034,13 +5096,22 @@ begin DoBeforeClean(Apackage); if AllTargets then begin - for ACPU:=low(TCpu) to high(TCpu) do + // Remove the unit-directory completely. This is safer in case of files + // being renamed and such. See also bug 19655 + DirectoryList := TStringList.Create; + try + DirectoryList.Add(ExtractFileDir(APackage.GetUnitsOutputDir(ACPU,AOS))); + CmdRemoveTrees(DirectoryList); + finally + DirectoryList.Free; + end; +{ for ACPU:=low(TCpu) to high(TCpu) do for AOS:=low(TOS) to high(TOS) do begin if FileExists(APackage.GetUnitsOutputDir(ACPU,AOS)) or FileExists(APackage.GetBinOutputDir(ACPU,AOS)) then Clean(APackage,ACPU,AOS); - end; + end;} end else Clean(APackage, Defaults.CPU, Defaults.OS);