← Back to branch summary

~ubuntu-branches/ubuntu/utopic/castle-game-engine/utopic

« back to all changes in this revision

Viewing changes to tests/consoletestrunner.pas

  • Committer: Package Import Robot
  • Author(s): Abou Al Montacir
  • Date: 2013-04-27 18:06:40 UTC
  • Revision ID: package-import@ubuntu.com-20130427180640-eink4nmwzuivez1c
Tags: upstream-4.0.1
Import upstream version 4.0.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/consoletestrunner.pas
 
1
{ This is a template generated by Lazarus -> New Project -> FPCUnit Console
 
2
  test runner, reworked by Kambi to fit into a reusable unit. }
 
3
unit ConsoleTestRunner;
 
4
 
 
5
{$mode objfpc}{$H+}
 
6
 
 
7
interface
 
8
 
 
9
uses
 
10
  custapp, classes, sysutils, fpcunit, testreport, testregistry,
 
11
  PlainReporter;
 
12
 
 
13
Type
 
14
  TTestRunner = Class(TCustomApplication)
 
15
  private
 
16
    FPlainResultsWriter: TPlainResultsWriter;
 
17
  protected
 
18
    procedure DoRun ; Override;
 
19
    procedure doTestRun(aTest: TTest); virtual;
 
20
  public
 
21
    constructor Create(AOwner: TComponent); override;
 
22
    destructor Destroy; override;
 
23
  end;
 
24
 
 
25
Var
 
26
  { Use this to run your tests.
 
27
    Just call Application.Initialize, then Application.Run.
 
28
    This is created/destroyed in initialization/finalization
 
29
    of this unit. }
 
30
  Application : TTestRunner;
 
31
 
 
32
implementation
 
33
 
 
34
Const
 
35
  ShortOpts = 'alh';
 
36
  Longopts : Array[1..5] of String = (
 
37
  'all','list','format:','suite:','help');
 
38
  Version = 'Version 0.1';
 
39
 
 
40
constructor TTestRunner.Create(AOwner: TComponent);
 
41
begin
 
42
  inherited Create(AOwner);
 
43
  FPlainResultsWriter := TPlainResultsWriter.Create;
 
44
end;
 
45
 
 
46
destructor TTestRunner.Destroy;
 
47
begin
 
48
  FPlainResultsWriter.Free;
 
49
end;
 
50
 
 
51
procedure TTestRunner.doTestRun(aTest: TTest);
 
52
var
 
53
  testResult: TTestResult;
 
54
begin
 
55
  testResult := TTestResult.Create;
 
56
  try
 
57
    testResult.AddListener(FPlainResultsWriter);
 
58
    aTest.Run(testResult);
 
59
    FPlainResultsWriter.WriteResult(testResult);
 
60
  finally
 
61
    testResult.Free;
 
62
  end;
 
63
end;
 
64
 
 
65
procedure TTestRunner.DoRun;
 
66
var
 
67
  I : Integer;
 
68
  S : String;
 
69
  SuiteFound: boolean;
 
70
begin
 
71
  S:=CheckOptions(ShortOpts,LongOpts);
 
72
  If (S<>'') then
 
73
    Writeln(S);
 
74
  if HasOption('h', 'help') or (ParamCount = 0) then
 
75
  begin
 
76
    writeln(Title);
 
77
    writeln(Version);
 
78
    writeln('Usage: ');
 
79
    writeln('-l or --list to show a list of registered tests');
 
80
    writeln('default format is xml, add --format=latex to output the list as latex source');
 
81
    writeln('-a or --all to run all the tests and show the results in xml format');
 
82
    writeln('The results can be redirected to an xml file,');
 
83
    writeln('for example: ./testrunner --all > results.xml');
 
84
    writeln('use --suite=MyTestSuiteName to run only the tests in a single test suite class');
 
85
  end;
 
86
  if HasOption('l', 'list') then
 
87
  begin
 
88
    if HasOption('format') then
 
89
    begin
 
90
      if GetOptionValue('format') = 'latex' then
 
91
        writeln(GetSuiteAsLatex(GetTestRegistry))
 
92
      else
 
93
        writeln(GetSuiteAsXML(GetTestRegistry));
 
94
    end
 
95
    else
 
96
      writeln(GetSuiteAsXML(GetTestRegistry));
 
97
  end;
 
98
  if HasOption('a', 'all') then
 
99
  begin
 
100
    doTestRun(GetTestRegistry)
 
101
  end
 
102
  else
 
103
    if HasOption('suite') then
 
104
    begin
 
105
      S := '';
 
106
      S:=GetOptionValue('suite');
 
107
      if S = '' then
 
108
        for I := 0 to GetTestRegistry.Tests.count - 1 do
 
109
          writeln(GetTestRegistry[i].TestName)
 
110
      else
 
111
      begin
 
112
        SuiteFound := false;
 
113
        for I := 0 to GetTestRegistry.Tests.count - 1 do
 
114
          if GetTestRegistry[i].TestName = S then
 
115
          begin
 
116
            SuiteFound := true;
 
117
            doTestRun(GetTestRegistry[i]);
 
118
          end;
 
119
        if not SuiteFound then
 
120
          Writeln('Suite name "', S, '" not found');
 
121
      end;
 
122
    end;
 
123
  Terminate;
 
124
end;
 
125
 
 
126
initialization
 
127
  Application:=TTestRunner.Create(Nil);
 
128
  Application.Title := 'FPCUnit Console Test Case runner.';
 
129
finalization
 
130
  FreeAndNil(Application);
 
131
end.
 
 
b'\\ No newline at end of file'