Browse Source

* Added test-framework for fppkg

git-svn-id: trunk@35765 -
joost 8 years ago
parent
commit
1119207fe3

+ 5 - 0
.gitattributes

@@ -3428,6 +3428,11 @@ packages/fppkg/src/pkgpackagesstructure.pp svneol=native#text/plain
 packages/fppkg/src/pkgrepos.pp svneol=native#text/plain
 packages/fppkg/src/pkguninstalledsrcsrepo.pp svneol=native#text/plain
 packages/fppkg/src/pkgwget.pp svneol=native#text/plain
+packages/fppkg/tests/fppkg_tests.pp svneol=native#text/plain
+packages/fppkg/tests/fullfpcinstallationtests.pas svneol=native#text/plain
+packages/fppkg/tests/packages/base/packagea/fpmake.pp svneol=native#text/plain
+packages/fppkg/tests/packages/base/packagea/src/PackageAUnitA.pas svneol=native#text/plain
+packages/fppkg/tests/readme.txt svneol=native#text/plain
 packages/fuse/Makefile svneol=native#text/plain
 packages/fuse/Makefile.fpc svneol=native#text/plain
 packages/fuse/Makefile.fpc.fpcmake svneol=native#text/plain

+ 46 - 0
packages/fppkg/tests/fppkg_tests.pp

@@ -0,0 +1,46 @@
+program fppkg_tests;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$ifdef unix}
+  cthreads,
+  {$endif unix}
+  Classes,
+  CustApp,
+  consoletestrunner,
+  FullFPCInstallationTests;
+
+type
+
+  { TFppkgTestRunner }
+
+  TFppkgTestRunner = class(TTestRunner)
+  protected
+    procedure AppendLongOpts; override;
+    function GetShortOpts: string; override;
+  end;
+
+procedure TFppkgTestRunner.AppendLongOpts;
+begin
+  inherited AppendLongOpts;
+  LongOpts.Add('fpcsrcpath::');
+  LongOpts.Add('testpath:');
+  LongOpts.Add('startcompiler:');
+  LongOpts.Add('skipbuildtemplate');
+  LongOpts.Add('packagespath:');
+end;
+
+function TFppkgTestRunner.GetShortOpts: string;
+begin
+  Result := inherited GetShortOpts;
+  Result := Result + 'f:t:s:Tp:';
+end;
+
+begin
+  CustomApplication := TFppkgTestRunner.Create(nil);
+  CustomApplication.Initialize;
+  CustomApplication.Title := 'FPCUnit Console test runner';
+  CustomApplication.Run;
+  CustomApplication.Free;
+end.

+ 344 - 0
packages/fppkg/tests/fullfpcinstallationtests.pas

@@ -0,0 +1,344 @@
+unit FullFPCInstallationTests;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes,
+  SysUtils,
+  fpcunit,
+  testdecorator,
+  testregistry,
+  CustApp,
+  process,
+  fpmkunit,
+  pkgFppkg, fprepos;
+
+type
+
+  { TFullFPCInstallationTests }
+
+  TFullFPCInstallationTests = class(TTestCase)
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+  published
+    procedure TestListPackages;
+    procedure IntTestListPackages;
+    procedure TestPackageA;
+  end;
+
+  { TFullFPCInstallationSetup }
+
+  TFullFPCInstallationSetup = class(TTestSetup)
+  private
+    class var
+      FFPCSourcePath: string;
+      FTestPath: string;
+      FPackagesPath: string;
+      FStartCompiler: string;
+      FTargetCPU: string;
+      FTargetOS: string;
+      FCompilerVersion: string;
+  protected
+    procedure OneTimeSetup; override;
+    procedure OneTimeTearDown; override;
+  public
+    class function GetCurrentTestPath: string;
+    class function GetTemplatePath: string;
+    class function GetTestPath: string;
+    class function GetBasePackagesPath: string;
+    class function GetCurrentTestBasePackagesPath: string;
+    class function GetTestBinPath: string;
+    class function GetTargetString: string;
+    class function GetCompilerVersion: string;
+    class function SyncPackageIntoCurrentTest(APackageName: string): string;
+  end;
+
+implementation
+
+function RunTestCommandIndir(const Curdir:string; const Exename:string; const Commands:array of string; TaskDescription: string):string;
+var
+  CommandOutput: string;
+  i: integer;
+  CommandLine: string;
+  ExitStatus: Integer;
+begin
+  if RunCommandInDir(Curdir, Exename, Commands, CommandOutput, ExitStatus, [poStderrToOutPut]) <> 0 then
+    raise Exception.CreateFmt('Failed to run ''%s''', [exename]);
+  if ExitStatus<>0 then
+    begin
+    for i := 0 to length(Commands) -1 do
+      begin
+      CommandLine := CommandLine + ' ' + Commands[i];
+      end;
+    raise Exception.CreateFmt('Failed to %s.' +sLineBreak+ 'Current directory: ' +Curdir+ sLineBreak + 'command line: ' + Exename + CommandLine + sLineBreak + ' Output: ' + sLineBreak + CommandOutput, [TaskDescription]);
+    end;
+  result := CommandOutput;
+end;
+
+function RunFppkgIndir(const Curdir:string; Commands: array of string; TaskDescription: string):string;
+var
+  i: Integer;
+  StrArr: array of string;
+begin
+  i := length(Commands);
+  SetLength(StrArr, i + 2);
+  StrArr[i] := '-C';
+  StrArr[i+1] := ConcatPaths([TFullFPCInstallationSetup.GetCurrentTestPath,'etc','fppkg.cfg']);
+  for i := 0 to length(Commands) -1 do
+    StrArr[i] := Commands[i];
+  Result := RunTestCommandIndir(Curdir, TFullFPCInstallationSetup.GetTestBinPath+'fppkg', StrArr, TaskDescription);
+end;
+
+function DeleteDirectory(const DirectoryName: string; OnlyChildren: boolean): boolean;
+const
+  //Don't follow symlinks on *nix, just delete them
+  DeleteMask = faAnyFile {$ifdef unix} or faSymLink{%H-} {$endif unix};
+var
+  FileInfo: TSearchRec;
+  CurSrcDir: String;
+  CurFilename: String;
+begin
+  Result:=false;
+  CurSrcDir:=IncludeTrailingPathDelimiter(DirectoryName);
+  if FindFirst(CurSrcDir+AllFilesMask,DeleteMask,FileInfo)=0 then begin
+    repeat
+      // check if special file
+      if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') then
+        continue;
+      CurFilename:=CurSrcDir+FileInfo.Name;
+      if ((FileInfo.Attr and faDirectory)>0)
+         {$ifdef unix} and ((FileInfo.Attr and faSymLink{%H-})=0) {$endif unix} then begin
+        if not DeleteDirectory(CurFilename,false) then exit;
+      end else begin
+        if not DeleteFile(CurFilename) then exit;
+      end;
+    until FindNext(FileInfo)<>0;
+  end;
+  FindClose(FileInfo);
+  if (not OnlyChildren) and (not RemoveDir(CurSrcDir)) then exit;
+  Result:=true;
+end;
+
+{ TFullFPCInstallationSetup }
+
+procedure TFullFPCInstallationSetup.OneTimeSetup;
+var
+  TemplatePath: string;
+  LocalBasePath: string;
+  MakeParams: array of string;
+begin
+  FFPCSourcePath := CustomApplication.GetOptionValue('f','fpcsrcpath');
+  if FFPCSourcePath<>'' then
+    FFPCSourcePath := ExpandFileName(FFPCSourcePath);
+  FStartCompiler := CustomApplication.GetOptionValue('s','startcompiler');
+  FTestPath := ExpandFileName(CustomApplication.GetOptionValue('t','testpath'));
+  if FTestPath='' then
+    FTestPath := IncludeTrailingPathDelimiter(ConcatPaths([ExtractFilePath(ParamStr(0)),'testroot']))
+  else
+    FTestPath := ExpandFileName(FTestPath);
+  FPackagesPath := CustomApplication.GetOptionValue('p','packagespath');
+  if FPackagesPath='' then
+    FPackagesPath := IncludeTrailingPathDelimiter(ConcatPaths([ExtractFilePath(ParamStr(0)),'packages']))
+  else
+    FPackagesPath := ExpandFileName(FPackagesPath);
+
+  if not CustomApplication.HasOption('T', 'skipbuildtemplate') then
+    begin
+    TemplatePath := GetTemplatePath;
+    if DirectoryExists(GetTestPath) and not DeleteDirectory(GetTestPath, False) then
+      raise Exception.CreateFmt('Failed to remove source-path ''%s''', [GetTestPath]);
+
+    ForceDirectories(GetTemplatePath);
+
+    SetLength(MakeParams, 2);
+    MakeParams[0] := 'clean';
+    MakeParams[1] := 'all';
+    if FStartCompiler<>'' then
+      begin
+      SetLength(MakeParams, length(MakeParams)+1);
+      MakeParams[High(MakeParams)] := 'PP='+FStartCompiler;
+      end;
+
+    RunTestCommandIndir(FFPCSourcePath, 'make', MakeParams, 'compile FPC');
+
+    MakeParams[0] := 'install';
+    MakeParams[1] := 'PREFIX='+GetTemplatePath;
+    RunTestCommandIndir(FFPCSourcePath, 'make', MakeParams, 'install FPC');
+
+    LocalBasePath :=  IncludeTrailingPathDelimiter(ConcatPaths([GetTemplatePath, 'user','lib','fpc']));
+    FCompilerVersion := Trim(RunTestCommandIndir(GetTemplatePath, GetTemplatePath+'bin'+PathDelim+'fpc', ['-iV'], 'get compiler-version'));
+
+    ForceDirectories(LocalBasePath+FCompilerVersion);
+
+    SetLength(MakeParams, 8);
+    MakeParams[0] := '-o';
+    MakeParams[1] := GetTemplatePath+PathDelim+'fpc.cfg';
+    MakeParams[2] := '-d';
+    MakeParams[3] := 'basepath='+ConcatPaths([GetCurrentTestPath, 'lib','fpc','$fpcversion']);
+    MakeParams[4] := '-d';
+    MakeParams[5] := 'sharepath='+ConcatPaths([GetCurrentTestPath, 'share','fpc','$fpcversion']);
+    MakeParams[6] := '-d';
+    MakeParams[7] := 'localbasepath='+LocalBasePath+'$fpcversion';
+    RunTestCommandIndir(ConcatPaths([GetTemplatePath,'bin']), 'fpcmkcfg', MakeParams, 'create fpc.cfg');
+
+    SetLength(MakeParams, 12);
+    MakeParams[1] := ConcatPaths([GetTemplatePath, 'etc', 'fppkg.cfg']);
+    MakeParams[8] := '-3';
+    MakeParams[9] := '-p';
+    MakeParams[3] := 'GlobalPath='+ConcatPaths([GetCurrentTestPath, 'lib', 'fpc']);
+    MakeParams[5] := 'GlobalPrefix='+GetCurrentTestPath;
+    MakeParams[10] := '-d';
+    MakeParams[11] := 'LocalRepository='+ConcatPaths([GetCurrentTestPath, 'user'])+PathDelim;
+    RunTestCommandIndir(ConcatPaths([GetTemplatePath,'bin']), 'fpcmkcfg', MakeParams, 'create fppkg.cfg');
+
+
+    SetLength(MakeParams, 12);
+    MakeParams[1] := ConcatPaths([TemplatePath, 'user', 'config', 'default']);
+    MakeParams[8] := '-4';
+    MakeParams[9] := '-p';
+    MakeParams[3] := 'GlobalPath='+ConcatPaths([GetCurrentTestPath, 'lib','fpc']);
+    MakeParams[5] := 'fpcbin='+ConcatPaths([GetCurrentTestPath, 'bin','fpc']);
+    MakeParams[10] := '-d';
+    MakeParams[11] := 'LocalRepository='+ConcatPaths([GetCurrentTestPath, 'user'])+PathDelim;
+    RunTestCommandIndir(ConcatPaths([TemplatePath,'bin']), 'fpcmkcfg', MakeParams, 'create default fppkg compiler file');
+
+    ForceDirectories(ConcatPaths([TemplatePath, 'user','config','conf.d']));
+    end
+  else
+    begin
+    FCompilerVersion := Trim(RunTestCommandIndir(GetTemplatePath, GetTemplatePath+'bin'+PathDelim+'fpc', ['-iV'], 'get compiler-version'));
+    end;
+  FTargetOS := Trim(RunTestCommandIndir(GetTemplatePath, GetTemplatePath+'bin'+PathDelim+'fpc', ['-iTO'], 'get target-OS'));
+  FTargetCPU := Trim(RunTestCommandIndir(GetTemplatePath, GetTemplatePath+'bin'+PathDelim+'fpc', ['-iTP'], 'get target-CPU'));
+end;
+
+procedure TFullFPCInstallationSetup.OneTimeTearDown;
+begin
+
+end;
+
+class function TFullFPCInstallationSetup.GetCurrentTestPath: string;
+begin
+  Result := IncludeTrailingPathDelimiter(ConcatPaths([FTestPath,'currenttest']));
+end;
+
+class function TFullFPCInstallationSetup.GetTemplatePath: string;
+begin
+  Result := IncludeTrailingPathDelimiter(ConcatPaths([FTestPath,'templates','fullfpc']));
+end;
+
+class function TFullFPCInstallationSetup.GetTestPath: string;
+begin
+  Result := FTestPath;
+end;
+
+class function TFullFPCInstallationSetup.GetBasePackagesPath: string;
+begin
+  Result := IncludeTrailingPathDelimiter(ConcatPaths([FPackagesPath, 'base']));
+end;
+
+class function TFullFPCInstallationSetup.GetCurrentTestBasePackagesPath: string;
+begin
+  Result := IncludeTrailingPathDelimiter(ConcatPaths([GetCurrentTestPath, 'packages']));
+end;
+
+class function TFullFPCInstallationSetup.GetTestBinPath: string;
+begin
+  Result := IncludeTrailingPathDelimiter(ConcatPaths([GetCurrentTestPath,'bin']));
+end;
+
+class function TFullFPCInstallationSetup.GetTargetString: string;
+begin
+  Result := FTargetCPU + '-' + FTargetOS;
+end;
+
+class function TFullFPCInstallationSetup.GetCompilerVersion: string;
+begin
+  Result := FCompilerVersion;
+end;
+
+class function TFullFPCInstallationSetup.SyncPackageIntoCurrentTest(APackageName: string): string;
+begin
+  ForceDirectories(ConcatPaths([TFullFPCInstallationSetup.GetTestPath, 'currenttest', 'packages']));
+  RunTestCommandIndir(TFullFPCInstallationSetup.GetTestPath, 'rsync', ['-rtvu', '--delete', TFullFPCInstallationSetup.GetBasePackagesPath+APackageName+PathDelim, TFullFPCInstallationSetup.GetCurrentTestBasePackagesPath+APackageName], 'sync template');
+end;
+
+procedure TFullFPCInstallationTests.SetUp;
+begin
+  RunTestCommandIndir(TFullFPCInstallationSetup.GetTestPath, 'rsync', ['-rtvu', '--delete', 'templates/fullfpc/', 'currenttest/'], 'sync template');
+end;
+
+procedure TFullFPCInstallationTests.TearDown;
+begin
+
+end;
+
+procedure TFullFPCInstallationTests.TestListPackages;
+var
+  s: String;
+begin
+  s := RunFppkgIndir(TFullFPCInstallationSetup.GetTestPath, ['list'], 'fppkg list');
+  Check(pos('rtl',s) > 0, 'Package rtl not found in fppkg-package list');
+end;
+
+procedure TFullFPCInstallationTests.IntTestListPackages;
+var
+  FPpkg: TpkgFPpkg;
+  RTLPackage: TFPPackage;
+begin
+   FPpkg := TpkgFPpkg.Create(nil);
+   try
+     FPpkg.InitializeGlobalOptions(ConcatPaths([TFullFPCInstallationSetup.GetCurrentTestPath,'etc','fppkg.cfg']));
+     FPpkg.Options.GlobalSection.Downloader := 'FPC';
+     FPpkg.InitializeCompilerOptions;
+
+     FPpkg.CompilerOptions.InitCompilerDefaults;
+     FPpkg.FpmakeCompilerOptions.InitCompilerDefaults;
+     FPpkg.CompilerOptions.CheckCompilerValues;
+     FPpkg.FpmakeCompilerOptions.CheckCompilerValues;
+     FPpkg.LoadLocalAvailableMirrors;
+
+     FPpkg.ScanAvailablePackages;
+     FPpkg.ScanPackages;
+
+     RTLPackage := FPpkg.RepositoryByName('fpc').FindPackage('rtl');
+     CheckNotNull(RTLPackage, 'RTL package not found');
+     CheckEquals('3.1.1', RTLPackage.Version.AsString, 'RTL has not the same version as the compiler');
+   finally
+     FPpkg.Free;
+   end;
+end;
+
+procedure TFullFPCInstallationTests.TestPackageA;
+var
+  s: String;
+begin
+  TFullFPCInstallationSetup.SyncPackageIntoCurrentTest('packagea');
+  // Build and install package
+  RunFppkgIndir(TFullFPCInstallationSetup.GetCurrentTestBasePackagesPath + 'packagea', ['build'], 'build PackageA');
+  RunFppkgIndir(TFullFPCInstallationSetup.GetCurrentTestBasePackagesPath + 'packagea', ['install'], 'install PackageA');
+
+  // Test installation
+  s := RunFppkgIndir(TFullFPCInstallationSetup.GetCurrentTestPath, ['list'], 'list packages');
+  Check(pos('PackageA', s) > 0, 'Just installed PackageA is not in package-list');
+  Check(FileExists(ConcatPaths([TFullFPCInstallationSetup.GetCurrentTestPath,'user','lib','fpc', TFullFPCInstallationSetup.GetCompilerVersion, 'units',TFullFPCInstallationSetup.GetTargetString,'PackageA','PackageAUnitA.ppu'])), 'PackageAUnitA.ppu not found');
+  Check(FileExists(ConcatPaths([TFullFPCInstallationSetup.GetCurrentTestPath,'user','lib','fpc', TFullFPCInstallationSetup.GetCompilerVersion, 'units',TFullFPCInstallationSetup.GetTargetString,'PackageA','PackageAUnitA.o'])), 'PackageAUnitA.o not found');
+  Check(FileExists(ConcatPaths([TFullFPCInstallationSetup.GetCurrentTestPath,'user','lib','fpc', TFullFPCInstallationSetup.GetCompilerVersion, 'fpmkinst',TFullFPCInstallationSetup.GetTargetString,'PackageA.fpm'])), 'PackageAUnitA.fpm not found');
+
+  // uninstall package
+  RunFppkgIndir(TFullFPCInstallationSetup.GetCurrentTestBasePackagesPath + 'packagea', ['uninstall'], 'install PackageA');
+
+  // check uninstallation
+  s := RunFppkgIndir(TFullFPCInstallationSetup.GetCurrentTestPath, ['list'], 'list packages');
+  Check(pos('PackageA', s) = 0, 'Just de-installed PackageA is still in package-list');
+  CheckFalse(DirectoryExists(ConcatPaths([TFullFPCInstallationSetup.GetCurrentTestPath,'user','lib','fpc', TFullFPCInstallationSetup.GetCompilerVersion, 'units',TFullFPCInstallationSetup.GetTargetString,'PackageA'])), 'PackageAUnitA-directory found after uninstall');
+  CheckFalse(FileExists(ConcatPaths([TFullFPCInstallationSetup.GetCurrentTestPath,'user','lib','fpc', TFullFPCInstallationSetup.GetCompilerVersion, 'fpmkinst',TFullFPCInstallationSetup.GetTargetString,'PackageA.fpm'])), 'PackageAUnitA.fpm found after uninstall');
+end;
+
+Initialization
+  RegisterTestDecorator(TFullFPCInstallationSetup, TFullFPCInstallationTests);
+end.
+

+ 26 - 0
packages/fppkg/tests/packages/base/packagea/fpmake.pp

@@ -0,0 +1,26 @@
+{$mode objfpc}{$H+}
+program fpmake;
+
+uses fpmkunit;
+
+Var
+  P : TPackage;
+  T : TTarget;
+begin
+  With Installer do
+    begin
+    P:=AddPackage('PackageA');
+    P.Version:='1.2.3';
+
+    P.Author := 'Joost vam der Sluis';
+    P.License := 'GPL';
+    P.HomepageURL := 'www.freepascal.org';
+    P.Email := '';
+    P.Description := 'First basic test-package';
+ 
+    P.SourcePath.Add('src');
+ 
+    T:=P.Targets.AddUnit('PackageAUnitA.pas');
+    Run;
+    end;
+end.

+ 16 - 0
packages/fppkg/tests/packages/base/packagea/src/PackageAUnitA.pas

@@ -0,0 +1,16 @@
+Unit PackageAUnitA;
+
+{$mode objfpc}{$H+}
+
+interface
+
+function PackageAUnitAFunctionA: Boolean;
+
+implementation
+
+function PackageAUnitAFunctionA: Boolean;
+begin
+  Result := True;
+end;
+
+end.

+ 50 - 0
packages/fppkg/tests/readme.txt

@@ -0,0 +1,50 @@
+These tests are to thest the fppkg system.
+
+The tests have the structure of unit-tests, but are not real unit-tests, altough
+some tests may test the TpkgFPpkg-class in a unit-test way.
+
+To be able to test fppkg, fpc-installations are made in in the templates-
+directory. They can have several settings and options.
+
+On each test one of these templates is synchronised to the current-test
+directory. Then the test can do something to this current-test environment
+without influencing the environment for other tests. And without having to
+re-build the test-environment for each test.
+
+To be able to build the test-templates, the tests need the full sources of fpc
+and a start-compiler.
+
+Usage is the same as for other unit-tests. Special options are:
+
+ -f <path> or --fpcsrcpath=<path>
+   The location of the full fpc-sources (fpcsrc)
+
+ -t <path> or --testpath=<path>
+   The location where the test-environment and templates has are build
+   The default is the 'testroot' sub-directory of the directory where the
+   executable resides.
+
+ -p <path> or --packagespath=<path>
+   The location of the packages which are used in the tests. This are the
+   packages which are in the 'packages' directory that belongs to these tests.
+   The default is the 'packages' sub-directory of the directory where the
+   executable resides.
+
+ -s <startcompiler> or --startcompiler=<startcompiler>
+   The compiler that has to be used to compile fpc
+
+ -T or --skipbuildtemplate
+   Do not (re)-build the fpc-installation templates. To speed up the tests
+   when it is not necessary to recompile fpc.
+
+For example, to run the tests:
+
+  fppkg_tests --all --fpcsrcpath=~/svn/fpc-trunk --startcompiler=ppcx64_3.0.0
+
+Or to run the tests, but use a temporary directory for the test-setup:
+
+  fppkg_tests --all --fpcsrcpath=~/svn/fpc-trunk --startcompiler=ppcx64_3.0.0 --testpath=/tmp/temptest
+
+Or to run successive tests, without re-building the setup:
+
+  fppkg_tests --all --testpath=/tmp/temptest --skipbuildtemplate