← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to fcl/fpcunit/tests/suitetest.pp

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2005-05-30 11:59:10 UTC
  • mfrom: (1.2.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20050530115910-x5pbzm4qqta4i94h
Tags: 2.0.0-2
http://bugs.debian.org/310907
debian/fp-compiler.postinst.in: forgot to reapply the patch that
correctly creates the slave link to pc(1).  (Closes: #310907)

Show diffs side-by-side

added added

removed removed

Lines of Context:
fcl/fpcunit/tests/suitetest.pp
 
1
{$mode objfpc}
 
2
{$h+}
 
3
{
 
4
    $Id: suitetest.pp,v 1.4 2005/02/27 12:20:19 michael Exp $
 
5
    This file is part of the Free Component Library (FCL)
 
6
    Copyright (c) 2004 by Dean Zobec
 
7
 
 
8
    Port to Free Pascal of the JUnit framework.
 
9
 
 
10
    See the file COPYING.FPC, included in this distribution,
 
11
    for details about the copyright.
 
12
 
 
13
    This program is distributed in the hope that it will be useful,
 
14
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 
15
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
16
 
 
17
 **********************************************************************}
 
18
unit suitetest;
 
19
 
 
20
interface
 
21
 
 
22
uses
 
23
  fpcunit, testreport, testregistry;
 
24
 
 
25
type
 
26
 
 
27
  TNoTestCases = class(TTestCase)
 
28
  public
 
29
    procedure NoTestCase;
 
30
  end;
 
31
 
 
32
  {$M+}
 
33
  TNoTestCaseClass = class(TObject)
 
34
  published
 
35
    procedure TestSuccess;
 
36
  end;
 
37
  {$M-}
 
38
 
 
39
  TOneTestCase = class(TTestCase)
 
40
  public
 
41
    procedure NoTestCase;
 
42
  published
 
43
    procedure OnlyOneTestCase; virtual;
 
44
  end;
 
45
 
 
46
  TOverrideTestCase = class(TOneTestCase)
 
47
  published
 
48
    procedure OnlyOneTestCase; override;
 
49
  end;
 
50
 
 
51
 
 
52
  TInheritedTestCase = class(TOneTestCase)
 
53
  published
 
54
    procedure Test2;
 
55
  end;
 
56
 
 
57
  TSuiteTest = class(TTestCase)
 
58
  private
 
59
    FResult: TTestResult;
 
60
  protected
 
61
    procedure Setup; override;
 
62
    procedure Teardown; override;
 
63
  public
 
64
    class function Suite: TTestSuite;
 
65
  published
 
66
    procedure testNoTestCaseClass;
 
67
    procedure testNoTestCases;
 
68
    procedure testOneTestCase;
 
69
    procedure testInheritedTests;
 
70
    procedure testNotExistingTestCase;
 
71
    procedure testShadowedTests;
 
72
    procedure testAddTestSuiteFromClass;
 
73
    procedure testCreateTestSuiteFromArray;
 
74
  end;
 
75
 
 
76
 
 
77
implementation
 
78
 
 
79
procedure TNoTestCases.NoTestCase;
 
80
begin
 
81
end;
 
82
 
 
83
procedure TNoTestCaseClass.TestSuccess;
 
84
begin
 
85
end;
 
86
 
 
87
procedure TOneTestCase.NoTestCase;
 
88
begin
 
89
end;
 
90
 
 
91
procedure TOneTestCase.OnlyOneTestCase;
 
92
begin
 
93
end;
 
94
 
 
95
procedure TOverrideTestCase.OnlyOneTestCase;
 
96
begin
 
97
end;
 
98
 
 
99
procedure TInheritedTestCase.Test2;
 
100
begin
 
101
end;
 
102
 
 
103
procedure TSuiteTest.Setup;
 
104
begin
 
105
  FResult := TTestResult.Create;
 
106
end;
 
107
 
 
108
procedure TSuiteTest.Teardown;
 
109
begin
 
110
  FResult.Free;
 
111
end;
 
112
 
 
113
class function TSuiteTest.Suite: TTestSuite;
 
114
begin
 
115
  Result := TTestSuite.Create('TSuiteTest');
 
116
  Result.AddTest(TSuiteTest.CreateWithName('testNoTestCaseClass'));
 
117
  Result.AddTest(TSuiteTest.CreateWithName('testNoTestCases'));
 
118
  Result.AddTest(TSuiteTest.CreateWithName('testOneTestCase'));
 
119
  Result.AddTest(TSuiteTest.CreateWithName('testInheritedTests'));
 
120
  Result.AddTest(TSuiteTest.CreateWithName('testNotExistingTestCase'));
 
121
  Result.AddTest(TSuiteTest.CreateWithName('testShadowedTests'));
 
122
  Result.AddTest(TSuiteTest.CreateWithName('testAddTestSuiteFromClass'));
 
123
  Result.AddTest(TSuiteTest.CreateWithName('testCreateTestSuiteFromArray'));
 
124
end;
 
125
 
 
126
procedure TSuiteTest.testNoTestCaseClass;
 
127
var
 
128
  ts: TTestSuite;
 
129
begin
 
130
  ts := TTestSuite.Create(TNoTestCaseClass);
 
131
  ts.Run(FResult);
 
132
  ts.Free;
 
133
  AssertEquals(1, FResult.RunTests);
 
134
  AssertTrue(not FResult.WasSuccessful);
 
135
end;
 
136
 
 
137
procedure TSuiteTest.testNoTestCases;
 
138
var
 
139
  ts: TTestSuite;
 
140
begin
 
141
  ts := TTestSuite.Create(TNoTestCases);
 
142
  ts.Run(FResult);
 
143
  ts.Free;
 
144
  AssertTrue(FResult.RunTests = 1);
 
145
  AssertTrue(FResult.NumberOfFailures = 1);
 
146
  AssertTrue(not FResult.WasSuccessful);
 
147
end;
 
148
 
 
149
procedure TSuiteTest.testOneTestCase;
 
150
var
 
151
  ts: TTestSuite;
 
152
begin
 
153
  ts := TTestSuite.Create(TOneTestCase);
 
154
  ts.Run(FResult);
 
155
  ts.Free;
 
156
  AssertTrue(FResult.RunTests = 1);
 
157
  AssertTrue(FResult.NumberOfFailures = 0);
 
158
  AssertTrue(FResult.NumberOfErrors = 0);
 
159
  AssertTrue(FResult.WasSuccessful);
 
160
end;
 
161
 
 
162
procedure TSuiteTest.testInheritedTests;
 
163
var
 
164
  ts: TTestSuite;
 
165
begin
 
166
  ts := TTestSuite.Create(TInheritedTestCase);
 
167
  ts.Run(FResult);
 
168
  ts.Free;
 
169
  AssertEquals(2, FResult.RunTests);
 
170
  AssertTrue(FResult.WasSuccessful);
 
171
end;
 
172
 
 
173
procedure TSuiteTest.testNotExistingTestCase;
 
174
var
 
175
  t: TTestCase;
 
176
begin
 
177
  t := TSuiteTest.CreateWithName('notExistingMethod');
 
178
  t.Run(FResult);
 
179
  t.Free;
 
180
  AssertTrue(FResult.RunTests = 1);
 
181
  AssertTrue(FResult.NumberOfFailures = 1);
 
182
  AssertTrue(FResult.NumberOfErrors = 0);
 
183
end;
 
184
 
 
185
procedure TSuiteTest.testShadowedTests;
 
186
var
 
187
  ts: TTestSuite;
 
188
begin
 
189
  ts := TTestSuite.Create(TOverrideTestCase);
 
190
  ts.Run(FResult);
 
191
  ts.Free;
 
192
  AssertEquals(1, FResult.RunTests);
 
193
end;
 
194
 
 
195
procedure TSuiteTest.testAddTestSuiteFromClass;
 
196
var
 
197
  ts: TTestSuite;
 
198
begin
 
199
  ts := TTestSuite.Create;
 
200
  ts.AddTestSuiteFromClass(TOneTestCase);
 
201
  ts.Run(FResult);
 
202
  ts.Free;
 
203
  AssertEquals(1, FResult.RunTests);
 
204
end;
 
205
 
 
206
procedure TSuiteTest.testCreateTestSuiteFromArray;
 
207
var
 
208
  ts: TTestSuite;
 
209
begin
 
210
  ts := TTestSuite.Create([TOneTestCase, TInheritedTestCase]);
 
211
  try
 
212
    AssertEquals(3, ts.CountTestCases);
 
213
    AssertEquals(2, ts.Tests.Count);
 
214
    AssertEquals('TOneTestCase', ts[0].TestName);
 
215
    AssertEquals('TInheritedTestCase', ts[1].TestName);
 
216
  finally
 
217
    ts.Free;
 
218
  end;
 
219
end;
 
220
 
 
221
initialization
 
222
 
 
223
  RegisterTests([TSuiteTest]);
 
224
 
 
225
end.
 
226