Browse Source

* New patch from Dean Zobec
- memory leaks fixed in the money example;
- no more need to start the test methods with "test"

michael 20 years ago
parent
commit
123f82f176

+ 3 - 3
fcl/fpcunit/exampletests/fpcunittests.pp

@@ -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;

+ 8 - 4
fcl/fpcunit/exampletests/money.pp

@@ -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;

+ 16 - 6
fcl/fpcunit/exampletests/moneytest.pp

@@ -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;

+ 1 - 8
fcl/fpcunit/fpcunit.pp

@@ -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;