Browse Source

* Added iphonesim target, bug #19146
* Clean empty directories, bug #19153

git-svn-id: trunk@17398 -

joost 14 years ago
parent
commit
b3edae8887
1 changed files with 97 additions and 4 deletions
  1. 97 4
      packages/fpmkunit/src/fpmkunit.pp

+ 97 - 4
packages/fpmkunit/src/fpmkunit.pp

@@ -69,7 +69,7 @@ Type
     linux,go32v2,win32,os2,freebsd,beos,netbsd,
     amiga,atari, solaris, qnx, netware, openbsd,wdosx,
     palmos,macos,darwin,emx,watcom,morphos,netwlibc,
-    win64,wince,gba,nds,embedded,symbian,haiku
+    win64,wince,gba,nds,embedded,symbian,haiku,iphonesim
   );
   TOSes = Set of TOS;
 
@@ -114,8 +114,8 @@ Const
 
   AllOSes = [Low(TOS)..High(TOS)];
   AllCPUs = [Low(TCPU)..High(TCPU)];
-  AllUnixOSes  = [Linux,FreeBSD,NetBSD,OpenBSD,Darwin,QNX,BeOS,Solaris,Haiku];
-  AllBSDOSes      = [FreeBSD,NetBSD,OpenBSD,Darwin];
+  AllUnixOSes  = [Linux,FreeBSD,NetBSD,OpenBSD,Darwin,QNX,BeOS,Solaris,Haiku,iphonesim];
+  AllBSDOSes      = [FreeBSD,NetBSD,OpenBSD,Darwin,iphonesim];
   AllWindowsOSes  = [Win32,Win64,WinCE];
 
   { This table is kept OS,Cpu because it is easier to maintain (PFV) }
@@ -149,7 +149,8 @@ Const
     { nds    }  ( false, false, false, false, false, false, true,  false, false, false),
     { embedded }( false, true,  true,  true,  true,  true,  true,  true,  true,  true ),
     { symbian } ( false, true,  false, false, false, false, true,  false, false, false),
-    { haiku }   ( false, true,  false, false, false, false, false, false, false, false) 
+    { haiku }   ( false, true,  false, false, false, false, false, false, false, false),
+    { iphonesim}( false, true,  false, false, false, false, false, false, false, false)
   );
 
   // Useful
@@ -668,6 +669,7 @@ Type
     FBinInstallDir,
     FDocInstallDir,
     FExamplesInstallDir : String;
+    FRemoveDir: String;
     FRemove: String;
     FTarget: String;
     FUnixPaths: Boolean;
@@ -726,6 +728,7 @@ Type
     Property Copy : String Read FCopy Write FCopy;             // copy $(FILES) to $(DEST)
     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 MkDir : String Read FMkDir write FMkDir;          // Make $(DIRECTORY)
     Property Archive : String Read FArchive Write FArchive;    // zip $(ARCHIVE) $(FILESORDIRS)
     // Misc
@@ -781,6 +784,7 @@ Type
     Procedure SysCopyFile(Const Src,Dest : String); virtual;
     Procedure SysMoveFile(Const Src,Dest : String); virtual;
     Procedure SysDeleteFile(Const AFileName : String); virtual;
+    Procedure SysDeleteDirectory(Const ADirectoryName : String); virtual;
     Procedure SysArchiveFiles(List : TStrings; Const AFileName : String); virtual;
     procedure LogIndent;
     procedure LogUnIndent;
@@ -794,6 +798,7 @@ Type
     Procedure LogSearchPath(const ASearchPathName:string;Path:TConditionalStrings; ACPU:TCPU;AOS:TOS);
     Function FindFileInPath(Path:TConditionalStrings; AFileName:String; var FoundPath:String;ACPU:TCPU;AOS:TOS):Boolean;
 
+    procedure GetDirectoriesFromFilelist(const AFileList, ADirectoryList: TStringList);
     //package commands
     Procedure ResolveFileNames(APackage : TPackage; ACPU:TCPU;AOS:TOS;DoChangeDir:boolean=true);
     function  GetUnitDir(APackage:TPackage):String;
@@ -813,6 +818,7 @@ Type
     Procedure CmdDeleteFiles(List : TStrings);
     Procedure CmdArchiveFiles(List : TStrings; Const ArchiveFile : String);
     Procedure CmdRenameFile(SourceName, DestName : String);
+    Procedure CmdRemoveDirs(List: TStrings);
     Procedure ExecuteCommands(Commands : TCommands; At : TCommandAt);
     // Dependency commands
     Function  DependencyOK(ADependency : TDependency) : Boolean;
@@ -1027,6 +1033,7 @@ ResourceString
   SErrExternalCommandFailed = 'External command "%s" failed with exit code %d. Console output:'+LineEnding+'%s';
   SErrCreatingDirectory = 'Failed to create directory "%s"';
   SErrDeletingFile      = 'Failed to delete file "%s"';
+  SErrRemovingDirectory = 'Failed to remove directory "%s"';
   SErrMovingFile        = 'Failed to move file "%s" to "%s"';
   SErrCopyingFile       = 'Failed to copy file "%s" to "%s"';
   SErrChangeDirFailed   = 'Failed to enter directory "%s"';
@@ -1097,6 +1104,8 @@ ResourceString
   SDbgEnterDir              = 'Entering directory "%s"';
   SDbgPackageChecksumChanged = 'Dependent package %s is modified';
   SDbgFileDoesNotExist      = 'File "%s" does not exist';
+  SDbgDirectoryDoesNotExist = 'Directory "%s" does not exist';
+  SDbgDirectoryNotEmpty     = 'Directory "%s" is not empty. Will not remove';
 
   // Help messages for usage
   SValue              = 'Value';
@@ -1135,6 +1144,7 @@ Const
   KeyMkDir    = 'MkDir';
   KeyMove     = 'Move';
   KeyRemove   = 'Remove';
+  KeyRemoveDir= 'RemoveDir';
   KeyOptions  = 'Options';
   KeyCPU      = 'CPU';
   KeyOS       = 'OS';
@@ -1267,6 +1277,28 @@ begin
 end;
 {$endif HAS_UNIT_PROCESS}
 
+function IsDirectoryEmpty(const directory : string) : boolean;
+var
+  searchRec: TSearchRec;
+  SearchResult: longint;
+begin
+  result := true;
+  SearchResult := FindFirst(IncludeTrailingPathDelimiter(directory)+'*.*', faAnyFile, searchRec);
+  try
+    while SearchResult=0 do
+      begin
+        if (searchRec.Name<>'.') and (searchRec.Name<>'..') then
+           begin
+             result := false;
+             break;
+           end;
+        SearchResult := FindNext(searchRec);
+      end;
+  finally
+    FindClose(searchRec);
+  end;
+end;
+
 function ParsecompilerOutput(M: TMemoryStream; Verbose: boolean): string;
 type
   TParseCompilerOutputState = (cosBeginOfLine, cosSearchColon, cosParseNumber, cosOther);
@@ -2968,6 +3000,7 @@ begin
       Values[KeyDocInstallDir]:=FDocInstallDir;
       Values[KeyExamplesInstallDir]:=FExamplesInstallDir;
       Values[KeyRemove]:=FRemove;
+      Values[KeyRemoveDir]:=FRemoveDir;
       Values[KeyTarget]:=FTarget;
       if FNoFPCCfg then
         Values[KeyNoFPCCfg]:='Y';
@@ -3007,6 +3040,7 @@ begin
       FMkDir:=Values[KeyMkDir];
       FMove:=Values[KeyMove];
       FRemove:=Values[KeyRemove];
+      FRemoveDir:=Values[KeyRemoveDir];
       Options:=OptionsToStringList(Values[KeyOptions]);
       Line:=Values[KeyCPU];
       If (Line<>'') then
@@ -3616,6 +3650,16 @@ begin
     Error(SErrDeletingFile,[AFileName]);
 end;
 
+procedure TBuildEngine.SysDeleteDirectory(const ADirectoryName: String);
+begin
+  if not DirectoryExists(ADirectoryName) then
+    Log(vldebug,SDbgDirectoryDoesNotExist,[ADirectoryName])
+  else if not IsDirectoryEmpty(ADirectoryName) then
+    Log(vldebug,SDbgDirectoryNotEmpty,[ADirectoryName])
+  else If Not RemoveDir(ADirectoryName) then
+    Error(SErrRemovingDirectory,[ADirectoryName]);
+end;
+
 
 procedure TBuildEngine.SysArchiveFiles(List: TStrings;Const AFileName: String);
 begin
@@ -3777,6 +3821,21 @@ begin
     SysMoveFile(SourceName,DestName);
 end;
 
+procedure TBuildEngine.CmdRemoveDirs(List: TStrings);
+Var
+  Args : String;
+  I : Integer;
+begin
+  If (Defaults.RemoveDir<>'') then
+    begin
+      Args:=FileListToString(List,'');
+      ExecuteCommand(Defaults.RemoveDir,Args);
+    end
+  else
+    For I:=0 to List.Count-1 do
+      SysDeleteDirectory(List[i]);
+end;
+
 Function TBuildEngine.FileNewer(const Src,Dest : String) : Boolean;
 
 Var
@@ -3871,6 +3930,16 @@ begin
   FoundPath:='';
 end;
 
+procedure TBuildEngine.GetDirectoriesFromFilelist(const AFileList, ADirectoryList: TStringList);
+var
+  i: integer;
+begin
+  ADirectoryList.Sorted:=true;
+  ADirectoryList.Duplicates:=dupIgnore;
+  for i := 0 to AFileList.Count-1 do
+    ADirectoryList.Add(ExtractFileDir(AFileList.Strings[i]));
+end;
+
 
 Procedure TBuildEngine.ResolveFileNames(APackage : TPackage; ACPU:TCPU;AOS:TOS;DoChangeDir:boolean=true);
 
@@ -4872,6 +4941,7 @@ end;
 procedure TBuildEngine.Clean(APackage: TPackage);
 Var
   List : TStringList;
+  DirectoryList : TStringList;
 begin
   Log(vlInfo,SInfoCleaningPackage,[APackage.Name]);
   try
@@ -4882,7 +4952,30 @@ begin
     try
       APackage.GetCleanFiles(List,Defaults.CPU,Defaults.OS);
       if (List.Count>0) then
+        begin
         CmdDeleteFiles(List);
+        DirectoryList := TStringList.Create;
+        try
+          GetDirectoriesFromFilelist(List,DirectoryList);
+          CmdRemoveDirs(DirectoryList);
+
+          DirectoryList.Clear;
+          if DirectoryExists(APackage.GetBinOutputDir(Defaults.CPU,Defaults.OS)) then
+            DirectoryList.Add(APackage.GetBinOutputDir(Defaults.CPU,Defaults.OS));
+          if DirectoryExists(APackage.GetUnitsOutputDir(Defaults.CPU,Defaults.OS)) then
+            DirectoryList.Add(APackage.GetUnitsOutputDir(Defaults.CPU,Defaults.OS));
+          CmdRemoveDirs(DirectoryList);
+
+          DirectoryList.Clear;
+          if DirectoryExists(ExtractFileDir(APackage.GetBinOutputDir(Defaults.CPU,Defaults.OS))) then
+            DirectoryList.Add(ExtractFileDir(APackage.GetBinOutputDir(Defaults.CPU,Defaults.OS)));
+          if DirectoryExists(ExtractFileDir(APackage.GetUnitsOutputDir(Defaults.CPU,Defaults.OS))) then
+            DirectoryList.Add(ExtractFileDir(APackage.GetUnitsOutputDir(Defaults.CPU,Defaults.OS)));
+          CmdRemoveDirs(DirectoryList);
+        finally
+          DirectoryList.Free;
+        end;
+        end;
     Finally
       List.Free;
     end;