paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-19 21:19:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

* New patch from Dean Zobec

Browse Source 
- memory leaks fixed in the money example;
  - no more need to start the test methods with "test"
This commit is contained in:
michael 2004-12-08 19:12:32 +00:00
parent af35ebb4e7
commit 123f82f176
4 changed files with 28 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
fcl/fpcunit/exampletests/fpcunittests.pp
View File

@ -44,7 +44,7 @@ type
procedure SetUp; override;
procedure TearDown; override;
published
procedure TestCountTestCases;
procedure CheckCountTestCases;
procedure TestExtractMethods;
end;
@ -160,7 +160,7 @@ end;
procedure TTestSuiteTest.TestCountTestCases;
procedure TTestSuiteTest.CheckCountTestCases;
begin
AssertTrue(FSuite.CountTestCases = 2);
end;
@ -173,7 +173,7 @@ begin
s := '';
for i := 0 to FSuite.CountTestCases - 1 do
s := s + UpperCase(FSuite[i].TestName) + ' ';
AssertEquals('Failure in extracting methods:', 'TESTCOUNTTESTCASES TESTEXTRACTMETHODS ', s );
AssertEquals('Failure in extracting methods:', 'CHECKCOUNTTESTCASES TESTEXTRACTMETHODS ', s );
end;
procedure TAssertTest.TestEqualsInt;

12
fcl/fpcunit/exampletests/money.pp
View File

@ -152,12 +152,12 @@ end;
class function TMoneyBag.CreateWith(m1: IMoney; m2: IMoney): IMoney;
var
mb: TMoneyBag;
mb: IMoney;
begin
mb := TMoneyBag.Create;
m1.AppendTo(mb);
m2.AppendTo(mb);
Result := mb.Simplify;
m1.AppendTo(TMoneyBag(mb._Self));
m2.AppendTo(TMoneyBag(mb._Self));
Result := TMoneyBag(mb._Self).Simplify;
end;
constructor TMoneyBag.Create;
@ -166,7 +166,11 @@ begin
end;
destructor TMoneyBag.Destroy;
var
i: integer;
begin
for i := 0 to FMonies.Count - 1 do
IInterface(FMonies.items[i])._release;
FMonies.Free;
inherited Destroy;
end;

22
fcl/fpcunit/exampletests/moneytest.pp
View File

@ -121,11 +121,17 @@ begin
end;
procedure TMoneyTest.testIsZero;
var
F0CHF, F12USD, F0USD, FMB0: IMoney;
begin
AssertTrue('error: [0 CHF] is to be considered zero!', TMoney.Create(0, 'CHF').IsZero);
AssertFalse('error: [12 USD] is not to be considered zero!', TMoney.Create(12, 'USD').IsZero);
F0CHF := TMoney.Create(0, 'CHF');
F0USD := TMoney.Create(0, 'USD');
F12USD := TMoney.Create(12, 'USD');
AssertTrue('error: [0 CHF] is to be considered zero!', F0CHF.IsZero);
AssertFalse('error: [12 USD] is not to be considered zero!', F12USD.IsZero);
AssertTrue(FMB1.subtract(FMB1).isZero);
AssertTrue(TMoneyBag.CreateWith(TMoney.Create(0, 'CHF'), TMoney.Create(0, 'USD')).isZero);
FMB0 :=TMoneyBag.CreateWith(F0CHF, F0USD);
AssertTrue(FMB0.isZero);
end;
procedure TMoneyTest.testMixedSimpleAdd;
@ -171,10 +177,14 @@ end;
procedure TMoneyTest.testSimplify;
var
money: IMoney;
F26CHF, F28CHF, F54CHF: IMoney;
begin
money := TMoneyBag.CreateWith(TMoney.Create(26, 'CHF'), TMoney.Create(28, 'CHF'));
AssertTrue('Expected ' + TMoney.Create(54, 'CHF').toString + ' but was '
+ money.toString, TMoney.Create(54, 'CHF').equals(money));
F26CHF := TMoney.Create(26, 'CHF');
F28CHF := TMoney.Create(28, 'CHF');
money := TMoneyBag.CreateWith(F26CHF, F28CHF);
F54CHF := TMoney.Create(54, 'CHF');
AssertTrue('Expected ' + F54CHF.toString + ' but was '
+ money.toString, F54CHF.equals(money));
end;
procedure TMoneyTest.testNormalize2;

9
fcl/fpcunit/fpcunit.pp
View File

@ -160,7 +160,6 @@ type
FTestSuiteName: string;
function GetTest(Index: integer): TTest;
protected
function IsTestMethod(AMethodName: string): boolean; virtual;
function GetTestName: string; override;
function GetTestSuiteName: string; override;
procedure SetTestSuiteName(const aName: string); override;
@ -635,8 +634,7 @@ begin
GetMethodList(AClass, ml);
for i := 0 to ml.Count -1 do
begin
if IsTestMethod(ml.Strings[i]) then
AddTest(tc.CreateWith(ml.Strings[i], tc.ClassName));
AddTest(tc.CreateWith(ml.Strings[i], tc.ClassName));
end;
finally
ml.Free;
@ -703,11 +701,6 @@ begin
FTestSuiteName := aName;
end;
function TTestSuite.IsTestMethod(AMethodName: string): Boolean;
begin
Result := Pos('TEST', UpperCase(AMethodName))= 1;
end;
function TTestSuite.CountTestCases: integer;
var
i: integer;