mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-07 16:38:02 +02:00
added Console Testrunner project from Dean
git-svn-id: trunk@7210 -
This commit is contained in:
vincents
parent
1917ac9586
commit
07a5e02a5c
@ -42,8 +42,19 @@ type
|
||||
constructor Create; override;
|
||||
function GetLocalizedName: string; override;
|
||||
function GetLocalizedDescription: string; override;
|
||||
Function InitProject(AProject: TLazProject) : TModalResult; override;
|
||||
Function CreateStartFiles(AProject: TLazProject): TModalResult; override;
|
||||
procedure InitProject(AProject: TLazProject); override;
|
||||
procedure CreateStartFiles(AProject: TLazProject); override;
|
||||
end;
|
||||
|
||||
{ TFPCUnitConsoleApplicationDescriptor }
|
||||
|
||||
TFPCUnitConsoleApplicationDescriptor = class(TProjectDescriptor)
|
||||
public
|
||||
constructor Create; override;
|
||||
function GetLocalizedName: string; override;
|
||||
function GetLocalizedDescription: string; override;
|
||||
procedure InitProject(AProject: TLazProject); override;
|
||||
procedure CreateStartFiles(AProject: TLazProject); override;
|
||||
end;
|
||||
|
||||
{ TFileDescPascalUnitFPCUnitTestCase }
|
||||
@ -71,6 +82,7 @@ type
|
||||
|
||||
var
|
||||
ProjectDescriptorFPCUnitApplication: TFPCUnitApplicationDescriptor;
|
||||
ProjectDescriptorFPCUnitConsoleApp: TFPCUnitConsoleApplicationDescriptor;
|
||||
FileDescriptorFPCUnitTestCase: TFileDescPascalUnitFPCUnitTestCase;
|
||||
|
||||
procedure Register;
|
||||
@ -81,6 +93,8 @@ procedure Register;
|
||||
begin
|
||||
FileDescriptorFPCUnitTestCase:=TFileDescPascalUnitFPCUnitTestCase.Create;
|
||||
RegisterProjectFileDescriptor(FileDescriptorFPCUnitTestCase);
|
||||
ProjectDescriptorFPCUnitConsoleApp := TFPCUnitConsoleApplicationDescriptor.Create;
|
||||
RegisterProjectDescriptor(ProjectDescriptorFPCUnitConsoleApp);
|
||||
ProjectDescriptorFPCUnitApplication:=TFPCUnitApplicationDescriptor.Create;
|
||||
RegisterProjectDescriptor(ProjectDescriptorFPCUnitApplication);
|
||||
end;
|
||||
@ -90,7 +104,7 @@ end;
|
||||
constructor TFPCUnitApplicationDescriptor.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
Name:='FPCUnitApplication';
|
||||
Name:='FPCUnit Application';
|
||||
end;
|
||||
|
||||
function TFPCUnitApplicationDescriptor.GetLocalizedName: string;
|
||||
@ -109,7 +123,7 @@ begin
|
||||
+'automatically maintained by Lazarus.';
|
||||
end;
|
||||
|
||||
Function TFPCUnitApplicationDescriptor.InitProject(AProject: TLazProject) : TModalResult;
|
||||
procedure TFPCUnitApplicationDescriptor.InitProject(AProject: TLazProject);
|
||||
var
|
||||
le: string;
|
||||
NewSource: String;
|
||||
@ -146,14 +160,12 @@ begin
|
||||
|
||||
// compiler options
|
||||
AProject.LazCompilerOptions.UseLineInfoUnit:=true;
|
||||
Result:=mrOK;
|
||||
end;
|
||||
|
||||
Function TFPCUnitApplicationDescriptor.CreateStartFiles(AProject: TLazProject) :TModalResult;
|
||||
procedure TFPCUnitApplicationDescriptor.CreateStartFiles(AProject: TLazProject);
|
||||
begin
|
||||
LazarusIDE.DoNewEditorFile(FileDescriptorFPCUnitTestCase,'','',
|
||||
[nfIsPartOfProject,nfOpenInEditor,nfCreateDefaultSrc]);
|
||||
Result:=mrOK;
|
||||
end;
|
||||
|
||||
{ TFileDescPascalUnitFPCUnitTestCase }
|
||||
@ -161,7 +173,7 @@ end;
|
||||
constructor TFileDescPascalUnitFPCUnitTestCase.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
Name:='FPCUnitTestCase';
|
||||
Name:='FPCUnit TestCase';
|
||||
DefaultFilename:='testcase.pas';
|
||||
DefaultSourceName:='TestCase1';
|
||||
end;
|
||||
@ -287,5 +299,178 @@ begin
|
||||
+le;
|
||||
end;
|
||||
|
||||
{ TFPCUnitConsoleApplicationDescriptor }
|
||||
|
||||
constructor TFPCUnitConsoleApplicationDescriptor.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
Name:='FPCUnit Console Application';
|
||||
end;
|
||||
|
||||
function TFPCUnitConsoleApplicationDescriptor.GetLocalizedName: string;
|
||||
begin
|
||||
Result:='FPCUnit Console Test Application';
|
||||
end;
|
||||
|
||||
function TFPCUnitConsoleApplicationDescriptor.GetLocalizedDescription: string;
|
||||
var
|
||||
le: string;
|
||||
begin
|
||||
le := System.LineEnding;
|
||||
Result:='FPCUnit Console Test Application'+le+le
|
||||
+'An application to run fpcunit test cases in console mode.'+le
|
||||
+'The program file is '
|
||||
+'automatically maintained by Lazarus.';
|
||||
end;
|
||||
|
||||
procedure TFPCUnitConsoleApplicationDescriptor.InitProject(
|
||||
AProject: TLazProject);
|
||||
var
|
||||
le: string;
|
||||
NewSource: string;
|
||||
MainFile: TLazProjectFile;
|
||||
begin
|
||||
inherited InitProject(AProject);
|
||||
|
||||
MainFile:=AProject.CreateProjectFile('fpcunitproject1.lpr');
|
||||
MainFile.IsPartOfProject:=true;
|
||||
AProject.AddFile(MainFile,false);
|
||||
AProject.MainFileID:=0;
|
||||
|
||||
// create program source
|
||||
le:=LineEnding;
|
||||
NewSource:='program FPCUnitProject1;'+le
|
||||
+le
|
||||
+'{$mode objfpc}{$H+}'+le
|
||||
+le
|
||||
+'uses'+le
|
||||
+' custapp, classes, sysutils, fpcunit, testreport, testregistry;'+le
|
||||
+le
|
||||
+'Const'+le
|
||||
+' ShortOpts = ''alh'';'+le
|
||||
+' Longopts : Array[1..5] of String = ('+le
|
||||
+' ''all'',''list'',''format:'',''suite:'',''help'');'+le
|
||||
+' Version = ''Version 0.1'';'+le
|
||||
+le
|
||||
+'Type'+le
|
||||
+' TTestRunner = Class(TCustomApplication)'+le
|
||||
+' private'+le
|
||||
+' FXMLResultsWriter: TXMLResultsWriter;'+le
|
||||
+' protected'+le
|
||||
+' procedure DoRun ; Override;'+le
|
||||
+' procedure doTestRun(aTest: TTest); virtual;'+le
|
||||
+' public'+le
|
||||
+' constructor Create(AOwner: TComponent); override;'+le
|
||||
+' destructor Destroy; override;'+le
|
||||
+' end;'+le
|
||||
+le
|
||||
+'constructor TTestRunner.Create(AOwner: TComponent);'+le
|
||||
+'begin'+le
|
||||
+' inherited Create(AOwner);'+le
|
||||
+' FXMLResultsWriter := TXMLResultsWriter.Create;'+le
|
||||
+'end;'+le
|
||||
+le
|
||||
+'destructor TTestRunner.Destroy;'+le
|
||||
+'begin'+le
|
||||
+' FXMLResultsWriter.Free;'+le
|
||||
+'end;'+le
|
||||
+le
|
||||
+'procedure TTestRunner.doTestRun(aTest: TTest);'+le
|
||||
+'var'+le
|
||||
+' testResult: TTestResult;'+le
|
||||
+'begin'+le
|
||||
+' testResult := TTestResult.Create;'+le
|
||||
+' try'+le
|
||||
+' testResult.AddListener(FXMLResultsWriter);'+le
|
||||
+' FXMLResultsWriter.WriteHeader;'+le
|
||||
+' aTest.Run(testResult);'+le
|
||||
+' FXMLResultsWriter.WriteResult(testResult);'+le
|
||||
+' finally'+le
|
||||
+' testResult.Free;'+le
|
||||
+' end;'+le
|
||||
+'end;'+le
|
||||
+le
|
||||
+'procedure TTestRunner.DoRun;'+le
|
||||
+'var'+le
|
||||
+' I : Integer;'+le
|
||||
+' S : String;'+le
|
||||
+'begin'+le
|
||||
+' S:=CheckOptions(ShortOpts,LongOpts);'+le
|
||||
+' If (S<>'''') then'+le
|
||||
+' Writeln(S);'+le
|
||||
+' if HasOption(''h'', ''help'') or (ParamCount = 0) then'+le
|
||||
+' begin'+le
|
||||
+' writeln(Title);'+le
|
||||
+' writeln(Version);'+le
|
||||
+' writeln(''Usage: '');'+le
|
||||
+' writeln(''-l or --list to show a list of registered tests'');'+le
|
||||
+' writeln(''default format is xml, add --format=latex to output the list as latex source'');'+le
|
||||
+' writeln(''-a or --all to run all the tests and show the results in xml format'');'+le
|
||||
+' writeln(''The results can be redirected to an xml file,'');'+le
|
||||
+' writeln(''for example: ./testrunner --all > results.xml'');'+le
|
||||
+' writeln(''use --suite=MyTestSuiteName to run only the tests in a single test suite class'');'+le
|
||||
+' end;'+le
|
||||
+' if HasOption(''l'', ''list'') then'+le
|
||||
+' begin'+le
|
||||
+' if HasOption(''format'') then'+le
|
||||
+' begin'+le
|
||||
+' if GetOptionValue(''format'') = ''latex'' then'+le
|
||||
+' writeln(GetSuiteAsLatex(GetTestRegistry))'+le
|
||||
+' else'+le
|
||||
+' writeln(GetSuiteAsXML(GetTestRegistry));'+le
|
||||
+' end'+le
|
||||
+' else'+le
|
||||
+' writeln(GetSuiteAsXML(GetTestRegistry));'+le
|
||||
+' end;'+le
|
||||
+' if HasOption(''a'', ''all'') then'+le
|
||||
+' begin'+le
|
||||
+' doTestRun(GetTestRegistry)'+le
|
||||
+' end'+le
|
||||
+' else'+le
|
||||
+' if HasOption(''suite'') then'+le
|
||||
+' begin'+le
|
||||
+' S := '''';'+le
|
||||
+' S:=GetOptionValue(''suite'');'+le
|
||||
+' if S = '''' then'+le
|
||||
+' for I := 0 to GetTestRegistry.Tests.count - 1 do'+le
|
||||
+' writeln(GetTestRegistry[i].TestName)'+le
|
||||
+' else'+le
|
||||
+' for I := 0 to GetTestRegistry.Tests.count - 1 do'+le
|
||||
+' if GetTestRegistry[i].TestName = S then'+le
|
||||
+' begin'+le
|
||||
+' doTestRun(GetTestRegistry[i]);'+le
|
||||
+' end;'+le
|
||||
+' end;'+le
|
||||
+' Terminate;'+le
|
||||
+'end;'+le
|
||||
+le
|
||||
+'Var'+le
|
||||
+' App : TTestRunner;'+le
|
||||
+le
|
||||
+'begin'+le
|
||||
+' App:=TTestRunner.Create(Nil);'+le
|
||||
+' App.Initialize;'+le
|
||||
+' App.Title := ''FPCUnit Console Test Case runner.'';'+le
|
||||
+' App.Run;'+le
|
||||
+' App.Free;'+le
|
||||
+'end.'+le
|
||||
+le;
|
||||
AProject.MainFile.SetSourceText(NewSource);
|
||||
|
||||
// add
|
||||
AProject.AddPackageDependency('FCL');
|
||||
AProject.AddPackageDependency('FPCUnitTestRunner');
|
||||
|
||||
// compiler options
|
||||
AProject.LazCompilerOptions.UseLineInfoUnit:=true;
|
||||
end;
|
||||
|
||||
procedure TFPCUnitConsoleApplicationDescriptor.CreateStartFiles(
|
||||
AProject: TLazProject);
|
||||
begin
|
||||
LazarusIDE.DoNewEditorFile(FileDescriptorFPCUnitTestCase,'','',
|
||||
[nfIsPartOfProject,nfOpenInEditor,nfCreateDefaultSrc]);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user