1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
{
This file is part of the Free Component Library (FCL)
Copyright (c) 2004 by Dean Zobec, Michael Van Canneyt
an example of a console test runner of FPCUnit tests.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}
program testrunner;
{$mode objfpc}
{$h+}
uses
custapp, Classes, SysUtils, fpcunit, suiteconfig, testreport, testregistry;
const
ShortOpts = 'alh';
Longopts: Array[1..5] of String = (
'all','list','format:','suite:','help');
Version = 'Version 0.2';
type
TTestRunner = Class(TCustomApplication)
private
FXMLResultsWriter: TXMLResultsWriter;
protected
procedure DoRun ; Override;
procedure doTestRun(aTest: TTest); virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
constructor TTestRunner.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FXMLResultsWriter := TXMLResultsWriter.Create;
end;
destructor TTestRunner.Destroy;
begin
FXMLResultsWriter.Free;
end;
procedure TTestRunner.doTestRun(aTest: TTest);
var
testResult: TTestResult;
begin
testResult := TTestResult.Create;
try
testResult.AddListener(FXMLResultsWriter);
aTest.Run(testResult);
FXMLResultsWriter.WriteResult(testResult);
finally
testResult.Free;
end;
end;
procedure TTestRunner.DoRun;
var
I : Integer;
S : String;
begin
S:=CheckOptions(ShortOpts,LongOpts);
If (S<>'') then
Writeln(S);
if HasOption('h', 'help') or (ParamCount = 0) then
begin
writeln(Title);
writeln(Version);
writeln('Usage: ');
writeln('-l or --list to show a list of registered tests');
writeln('default format is xml, add --format=latex to output the list as latex source');
writeln('-a or --all to run all the tests and show the results in xml format');
writeln('The results can be redirected to an xml file,');
writeln('for example: ./testrunner --all > results.xml');
writeln('use --suite=MyTestSuiteName to run only the tests in a single test suite class');
end
else;
if HasOption('l', 'list') then
begin
if HasOption('format') then
begin
if GetOptionValue('format') = 'latex' then
writeln(GetSuiteAsLatex(GetTestRegistry))
else
writeln(GetSuiteAsXML(GetTestRegistry));
end
else
writeln(GetSuiteAsXML(GetTestRegistry));
end;
if HasOption('a', 'all') then
begin
doTestRun(GetTestRegistry)
end
else
if HasOption('suite') then
begin
S := '';
S:=GetOptionValue('suite');
if S = '' then
for I := 0 to GetTestRegistry.Tests.count - 1 do
writeln(GetTestRegistry[i].TestName)
else
for I := 0 to GetTestRegistry.Tests.count - 1 do
if GetTestRegistry[i].TestName = S then
begin
doTestRun(GetTestRegistry[i]);
end;
end;
Terminate;
end;
var
App: TTestRunner;
begin
App := TTestRunner.Create(nil);
App.Initialize;
App.Title := 'FPCUnit Console Test Case runner.';
App.Run;
App.Free;
end.
|
