开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Internet/网络编程 > Email服务器 > 查看源码
UnitTestFramework.pas
资源名称：EMailMasterbysuperroyor.rar　[点击查看]
上传用户：yjb1804
上传日期：2021-01-30
资源大小：3105k
文件大小：49k
源码类别：

Email服务器

开发平台：

Delphi

UnitTestFramework.pas：源码内容
  1. { Problem: TestRunAndTearDownFails has a leak of some sort. AV occurs outside
  2.   of entire framework at the end of the test. }
  4. { $Id: UnitTestFramework.pas,v 1.44 2006/07/19 02:52:55 judc Exp $ }
  5. {: DUnit: An XTreme testing framework for Delphi programs.
  6.    @author  The DUnit Group.
  7.    @version $Revision: 1.44 $
  8. }
  9. (*
  10.  * The contents of this file are subject to the Mozilla Public
  11.  * License Version 1.1 (the "License"); you may not use this file
  12.  * except in compliance with the License. You may obtain a copy of
  13.  * the License at http://www.mozilla.org/MPL/
  14.  *
  15.  * Software distributed under the License is distributed on an "AS
  16.  * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
  17.  * implied. See the License for the specific language governing
  18.  * rights and limitations under the License.
  19.  *
  20.  * The Original Code is DUnit.
  21.  *
  22.  * The Initial Developers of the Original Code are Kent Beck, Erich Gamma,
  23.  * and Juancarlo A馿z.
  24.  * Portions created The Initial Developers are Copyright (C) 1999-2000.
  25.  * Portions created by The DUnit Group are Copyright (C) 2000-2004.
  26.  * All rights reserved.
  27.  *
  28.  * Contributor(s):
  29.  * Kent Beck <kentbeck@csi.com>
  30.  * Erich Gamma <Erich_Gamma@oti.com>
  31.  * Juanco A馿z <juanco@users.sourceforge.net>
  32.  * Chris Morris <chrismo@users.sourceforge.net>
  33.  * Jeff Moore <JeffMoore@users.sourceforge.net>
  34.  * Kenneth Semeijn <kennethsem@users.sourceforge.net>
  35.  * Kris Golko <neuromancer@users.sourceforge.net>
  36.  * The DUnit group at SourceForge <http://dunit.sourceforge.net>
  37.  *
  38.  *)
  41. {$UNDEF DETECTMEMLEAKS}
  42. {$IFDEF VER180}
  43.   {$IFNDEF CLR}
  44.     {$DEFINE DETECTMEMLEAKS}
  45.   {$ENDIF}
  46. {$ELSE}
  47.   {$IFDEF FASTMM}
  48.     {$DEFINE DETECTMEMLEAKS}
  49.   {$ENDIF}
  50. {$ENDIF}
  52. unit UnitTestFramework;
  54. interface
  56. uses
  57.   {$IFNDEF LINUX}
  58.   Windows,
  59.   {$ENDIF}
  60.   SysUtils,
  61.   TestFramework;
  63. type
  64.   TMonitoredTestCase = class(TTestCase)
  65.   public
  66.     destructor Destroy; override;
  67.     procedure _AddRef;
  68.     procedure _Release;
  69.   end;
  71.   TVerifierTestCase = class(TTestCase)
  72.   protected
  73.     procedure Verify(AResult: TTestResult;
  74.       runCount, failCount, errCount: Integer);
  75.     procedure VerifyError(ATest: ITest; errCount: Integer = 1);
  76.     procedure VerifyFailure(ATest: ITest); virtual;
  77.     procedure VerifySuccess(ATest: ITest); virtual;
  78.     procedure VerifyLackOfSuccess(ATest: ITest);
  79.   end;
  81.   TVerifierTotalTestCase = class(TVerifierTestCase)
  82.   protected
  83.     procedure VerifySuccess(ATest: ITest); override;
  84.     procedure VerifyFailure(ATest: ITest); override;
  85.   end;
  87.   { ported from JUnit tests, then refactored a bit }
  88.   TTestTest = class(TVerifierTestCase)
  89.   private
  90.     fTestCount: integer;
  91.   protected
  92.     procedure SetUp; override;
  93.     procedure TearDown; override;
  94.   published
  95. {$IFDEF CLR}[Test]{$ENDIF}
  96.     procedure TestCheck;
  97. {$IFDEF CLR}[Test]{$ENDIF}
  98.     procedure TestCheckEqualsBinHexMessage;
  99. {$IFNDEF CLR} // don't expect Check(Not)EqualsMem to work under CLR -> pointers unsafe
  100.     procedure TestCheckEqualsMem;
  101.     procedure TestFirstByteDiff;
  102. {$ENDIF}
  103. {$IFDEF CLR}[Test]{$ENDIF}
  104.     procedure TestError;
  105. {$IFDEF CLR}[Test]{$ENDIF}
  106.     procedure TestFailure;
  107. {$IFDEF CLR}[Test]{$ENDIF}
  108.     procedure TestRegisterTest;
  109. {$IFDEF CLR}[Test]{$ENDIF}
  110.     procedure TestRunAndTearDownFails;
  111. {$IFDEF CLR}[Test]{$ENDIF}
  112.     procedure TestSetupException;
  113. {$IFDEF CLR}[Test]{$ENDIF}
  114.     procedure TestSuccess;
  115. {$IFDEF CLR}[Test]{$ENDIF}
  116.     procedure TestTearDownAfterError;
  117. {$IFDEF CLR}[Test]{$ENDIF}
  118.     procedure TestTearDownFails;
  119. {$IFDEF CLR}[Test]{$ENDIF}
  120.     procedure TestTearDownSetupFails;
  121. {$IFDEF CLR}[Test]{$ENDIF}
  122.     procedure TestWasNotSuccessful;
  123. {$IFDEF CLR}[Test]{$ENDIF}
  124.     procedure TestWasSuccessful;
  125. {$IFDEF CLR}[Test]{$ENDIF}
  126.     procedure TestWasStopped;
  127.     procedure TestEmptyTestFailure;
  128. {$IFDEF CLR}[Test]{$ENDIF}
  129.     procedure TestBoolToStr;
  130. {$IFDEF CLR}[Test]{$ENDIF}
  131.     procedure TestElapsedTestTime;
  132. {$IFDEF CLR}[Test]{$ENDIF}
  133.     procedure TestFailOnDisAllowedUnCalledCheck;
  134. {$IFDEF CLR}[Test]{$ENDIF}
  135.     procedure TestPassOnAllowedUnCalledCheck;
  136. {$IFDEF CLR}[Test]{$ENDIF}
  137.     procedure TestAlloweLeakListIterator;
  138.   end;
  140.   TTestMemLeakTestSuite = class(TVerifierTotalTestCase)
  141.   private
  142.     fTestCount: integer;
  143.   protected
  144.     procedure SetUp; override;
  145.     procedure TearDown; override;
  146.   published
  147. {$IFDEF CLR}[Test]{$ENDIF}
  148.     procedure TestClassCanDetectFailure;
  149. {$IFDEF CLR}[Test]{$ENDIF}
  150.     procedure TestCaseDoesNotLeak;
  151. {$IFDEF CLR}[Test]{$ENDIF}
  152.     procedure TestCaseLeaksTObject;
  153. {$IFDEF CLR}[Test]{$ENDIF}
  154.     procedure TestCaseLeaksTObjectReportDisabled;
  155. {$IFDEF CLR}[Test]{$ENDIF}
  156.     procedure TestCaseLeaksTObjectLeakOfSizeAllowed;
  157. {$IFDEF CLR}[Test]{$ENDIF}
  158.     procedure TestCaseLeaksTObjectLeakOfListSizeAllowed;
  159. {$IFDEF CLR}[Test]{$ENDIF}
  160.     procedure TestCaseLeaksAllowedTObjectLeakOfEmptyList;
  161. {$IFDEF CLR}[Test]{$ENDIF}
  162.     procedure TestCaseFailsOnOverSizeAllowedLeakArrayList;
  163. {$IFDEF CLR}[Test]{$ENDIF}
  164.     procedure TestCaseNoLeaksAtSetupTearDownLevel;
  165. {$IFDEF CLR}[Test]{$ENDIF}
  166.     procedure TestCaseLeaksAtSetupTearDownLevel;
  167. {$IFDEF CLR}[Test]{$ENDIF}
  168.     procedure TestCaseIgnoresLeaksAtSetupTearDownLevel;
  169. {$IFDEF CLR}[Test]{$ENDIF}
  170.     procedure TestCaseDoesNotIgnoreLeaksInTestProc;
  171.   end;
  173.   TTestTestSuite = class(TVerifierTestCase)
  174.   published
  175. {$IFDEF CLR}[Test]{$ENDIF}
  176.     procedure TestSuiteSetupTearDown;
  177.   end;
  179.   TTestBasicTestCase4Leaks = class(TTestCase)
  180.   published
  181. {$IFDEF CLR}[Test]{$ENDIF}
  182.     procedure TestCheckIfTAbstractTestLeaks;
  183. {$IFDEF CLR}[Test]{$ENDIF}
  184.     procedure TestCheckIfTTestResultLeaks;
  185. {$IFDEF CLR}[Test]{$ENDIF}
  186.     procedure TestCheckIfTStatusListnerLeaks;
  187. {$IFDEF CLR}[Test]{$ENDIF}
  188.     procedure TestCheckIfTTestFalureLeaks;
  189. {$IFDEF CLR}[Test]{$ENDIF}
  190.     procedure TestCheckIfTTestCaseLeaks;
  191. {$IFDEF CLR}[Test]{$ENDIF}
  192.     procedure TestCheckIfRunTTestCaseLeaks;
  193. {$IFDEF CLR}[Test]{$ENDIF}
  194.     procedure TestCheckIfEnumeratorLeaks;
  195. {$IFDEF CLR}[Test]{$ENDIF}
  196.     procedure TestCheckIfITestSuiteLeaks;
  197.   end;
  199.   { JUnit has no tests for this class }
  200.   TTestTestResult = class(TTestCase)
  201.   protected
  202.     procedure SetUp; override;
  204.   published
  205. {$IFDEF CLR}[Test]{$ENDIF}
  206.     procedure TestRun;
  207. {$IFDEF CLR}[Test]{$ENDIF}
  208.     procedure TestElapsedTime;
  209.   end;
  211.   TTestMethodEnumerator = class(TTestCase)
  212.   private
  213.     FMethodEnumerator: TMethodEnumerator;
  214.   published
  215. {$IFDEF CLR}[Test]{$ENDIF}
  216.     procedure TestMethodEnumerator;
  217.   end;
  219.   TTestExceptionChecks = class(TVerifierTestCase)
  220.   protected
  221.     procedure TestIndividualException(AName :string; FailCnt, ErrCnt :Integer);
  222.   published
  223. {$IFDEF CLR}[Test]{$ENDIF}
  224.     procedure TestExpectedException;
  225. {$IFDEF CLR}[Test]{$ENDIF}
  226.     procedure TestChecksAfterException;
  227. {$IFDEF CLR}[Test]{$ENDIF}
  228.     procedure TestDifferentFromExpected;
  229. {$IFDEF CLR}[Test]{$ENDIF}
  230.     procedure TestInheritsFromExpected;
  231. {$IFDEF CLR}[Test]{$ENDIF}
  232.     procedure TestCheckException;
  233. {$IFDEF CLR}[Test]{$ENDIF}
  234.     procedure TestCheckWrongException;
  235. {$IFDEF CLR}[Test]{$ENDIF}
  236.     procedure TestNoExceptionRaised;
  237. {$IFDEF CLR}[Test]{$ENDIF}
  238.     procedure TestCheckAndNoExceptionRaised;
  239. {$IFDEF CLR}[Test]{$ENDIF}
  240.     procedure TestNotRaised;
  241.   end;
  243.   TTestStatus = class(TVerifierTestCase)
  244.   published
  245.     procedure testStatus;
  246.   end;
  248.   TStringyObject = class(TObject)
  249.   public
  250.     AString: string;
  251.   end;
  253.   {: Create our own exception class so users can choose
  254.     to ignore it in the debugger }
  255.   EUnitTestException = class(EAbort)
  256.   end;
  258. implementation
  260. {$ifdef DETECTMEMLEAKS}
  261. uses
  262.   FastMMMonitorTest;
  263. {$endif}
  265. const
  266.   ARBITRARY_STOPEXCEPT_MSG = 'An arbitrary StopExpectingException message';
  267.   EXPECTED_STOPEXCEPT_MSG = 'Expected exception "EUnitTestException" '
  268.                             + 'but there was none. '
  269.                             + ARBITRARY_STOPEXCEPT_MSG;
  271. var
  272. // Used by code to test memory leak detection.
  273.   AnObject: TObject = nil;
  275. type
  276. // prototype for CheckEqualsBin/Hex
  277.   TCheckEqualsBinHex = procedure(expected,actual:longword; msg:string = '';
  278.                                     digits:integer=0) of object;
  280.   TRunExceptionCase = class(TMonitoredTestCase)
  281.   published
  282. {$IFDEF CLR}[Test]{$ENDIF}
  283.     procedure Test;
  284.   end;
  286.   TRunExceptionTornDown = class(TRunExceptionCase)
  287.   protected
  288.     procedure TearDown; override;
  289.   public
  290.     TornDown: boolean;
  291.   end;
  293.   TRunAndTearDownException = class(TRunExceptionTornDown)
  294.   protected
  295.     procedure TearDown; override;
  296.   end;
  298.   TRunFalseAssertCase = class(TMonitoredTestCase)
  299.   published
  300. {$IFDEF CLR}[Test]{$ENDIF}
  301.     procedure Test;
  302.   end;
  304.   TSetupException = class(TMonitoredTestCase)
  305.   public
  306.     procedure SetUp; override;
  307.   published
  308. {$IFDEF CLR}[Test]{$ENDIF}
  309.     procedure Test;
  310.   end;
  312.   TSetupExceptionTornDown = class(TRunExceptionTornDown)
  313.   public
  314.     procedure SetUp; override;
  315.   end;
  317.   TSuccessCase = class(TMonitoredTestCase)
  318.   published
  319. {$IFDEF CLR}[Test]{$ENDIF}
  320.     procedure Test;
  321.   end;
  323.   TFailsCase = class(TMonitoredTestCase)
  324.   published
  325. {$IFDEF CLR}[Test]{$ENDIF}
  326.     procedure Test;
  327.   end;
  329.   TTearDownException = class(TSuccessCase)
  330.   protected
  331.     procedure TearDown; override;
  332.   end;
  334.   TTestMethodEnumClass = class(TMonitoredTestCase)
  335.   published
  336. {$IFDEF CLR}[Test]{$ENDIF}
  337.     procedure Method0;
  338. {$IFDEF CLR}[Test]{$ENDIF}
  339.     procedure Method1;
  340. {$IFDEF CLR}[Test]{$ENDIF}
  341.     procedure Method2;
  342.   end;
  344.   TStopTest = class(TMonitoredTestCase)
  345.   private
  346.     procedure DoNothing;
  347.   published
  348. {$IFDEF CLR}[Test]{$ENDIF}
  349.     procedure testOne;
  350. {$IFDEF CLR}[Test]{$ENDIF}
  351.     procedure testTwo;
  352. {$IFDEF CLR}[Test]{$ENDIF}
  353.     procedure doStop;
  354. {$IFDEF CLR}[Test]{$ENDIF}
  355.     procedure notExecutedOne;
  356. {$IFDEF CLR}[Test]{$ENDIF}
  357.     procedure notExecutedTwo;
  358.   end;
  360.   TExpectedTest = class(TMonitoredTestCase)
  361.   protected
  362.     function  RaiseException :Integer;
  363. {$IFDEF CLR}
  364.   public
  365. {$ENDIF}
  366.     procedure RaiseExceptionProc;
  367.     procedure DoNothing;
  368.   published
  369. {$IFDEF CLR}[Test]{$ENDIF}
  370.     procedure testRaised;
  371. {$IFDEF CLR}[Test]{$ENDIF}
  372.     procedure TestNotRaised;
  373. {$IFDEF CLR}[Test]{$ENDIF}
  374.     procedure testEnd;
  375. {$IFDEF CLR}[Test]{$ENDIF}
  376.     procedure testStart;
  377. {$IFDEF CLR}[Test]{$ENDIF}
  378.     procedure TestChecksAfterException;
  379. {$IFDEF CLR}[Test]{$ENDIF}
  380.     procedure TestDifferentFromExpected;
  381. {$IFDEF CLR}[Test]{$ENDIF}
  382.     procedure TestInheritsFromExpected;
  383. {$IFDEF CLR}[Test]{$ENDIF}
  384.     procedure TestCheckException;
  385. {$IFDEF CLR}[Test]{$ENDIF}
  386.     procedure TestCheckWrongException;
  387. {$IFDEF CLR}[Test]{$ENDIF}
  388.     procedure TestNoExceptionRaised;
  389. {$IFDEF CLR}[Test]{$ENDIF}
  390.     procedure TestCheckAndNoExceptionRaised;
  391.   end;
  393.   TEmptyTest = class(TMonitoredTestCase)
  394.   published
  395. {$IFDEF CLR}[Test]{$ENDIF}
  396.     procedure Test;
  397. {$IFDEF CLR}[Test]{$ENDIF}
  398.     procedure NoChecksTest;
  399.   end;
  401.   TLeakyTest = class(TMonitoredTestCase)
  402.   public
  403.     procedure SetUp; override;
  404.   published
  405. {$IFDEF CLR}[Test]{$ENDIF}
  406.     procedure TestDoesNotLeak;
  407. {$IFDEF CLR}[Test]{$ENDIF}
  408.     procedure TestContainsTObjectLeak;
  409. {$IFDEF CLR}[Test]{$ENDIF}
  410.     procedure TestContainsAllowedTObjectLeak;
  411. {$IFDEF CLR}[Test]{$ENDIF}
  412.     procedure TestContainsAllowedTObjectLeakByList;
  413. {$IFDEF CLR}[Test]{$ENDIF}
  414.     procedure TestContainsAllowedTObjectLeakByEmptyList;
  415. {$IFDEF CLR}[Test]{$ENDIF}
  416.     procedure TestContainsAllowedLeakArrayLongList;
  417.   end;
  419.   TLeakySetupTearDown = class(TMonitoredTestCase)
  420.   public
  421.     FreeInTearDown: boolean;
  422.     procedure SetUp; override;
  423.     procedure TearDown; override;
  424.   published
  425. {$IFDEF CLR}[Test]{$ENDIF}
  426.     procedure TestCaseDoesNotLeak;
  427. {$IFDEF CLR}[Test]{$ENDIF}
  428.     procedure TestSetupTearDownLeakDetect;
  429.   end;
  431.   TTestWithStatusMsgs = class(TMonitoredTestCase)
  432.   published
  433. {$IFDEF CLR}[Test]{$ENDIF}
  434.     procedure Test;
  435.   end;
  437.   TFixtureSuite = class(TTestSuite)
  438.   public
  439.     SetUpCalled: boolean;
  440.     TearDownCalled: boolean;
  442.     procedure SetUp; override;
  443.     procedure TearDown; override;
  444.   end;
  446.   TMockedTimeCase = class(TTestCase)
  447.   public
  448.     function ElapsedTestTime: Cardinal; override;
  449.   published
  450. {$IFDEF CLR}[Test]{$ENDIF}
  451.     procedure SuccessOne;
  452. {$IFDEF CLR}[Test]{$ENDIF}
  453.     procedure SuccessTwo;
  454.   end;
  456.   TMockedTimeSuite = class(TTestSuite)
  457.   public
  458.     function ElapsedTestTime: Cardinal; override;
  459.   end;
  461. { TMonitoredTestCase }
  463. destructor TMonitoredTestCase.Destroy;
  464. begin
  465.   inherited Destroy;
  466. end;
  468. procedure TMonitoredTestCase._AddRef;
  469. begin
  470. {$IFNDEF CLR}
  471.   inherited _AddRef;
  472. {$ENDIF}
  473. end;
  475. procedure TMonitoredTestCase._Release;
  476. begin
  477. {$IFNDEF CLR}
  478.   inherited _Release;
  479. {$ENDIF}
  480. end;
  482. { TRunExceptionTornDown }
  484. procedure TRunExceptionTornDown.TearDown;
  485. begin
  486.   TornDown := true;
  487. end;
  489. { TRunAndTearDownException }
  491. procedure TRunAndTearDownException.TearDown;
  492. begin
  493.   inherited;
  494.   raise EUnitTestException.Create('');
  495. end;
  497. { TVerifierTestCase }
  499. procedure TVerifierTestCase.Verify(AResult: TTestResult;
  500.   runCount, failCount, errCount: Integer);
  501. begin
  502.   assert(AResult <> nil);
  503.   CheckEquals(runCount,  AResult.runCount,      'wrong RunCount');
  504.   CheckEquals(failCount, AResult.failureCount,  'wrong FailureCount');
  505.   CheckEquals(errCount,  AResult.errorCount,    'wrong ErrorCount');
  506. end;
  508. procedure TVerifierTestCase.VerifyError(ATest: ITest; errCount: Integer);
  509. var
  510.   AResult: TTestResult;
  511. begin
  512.   assert((ATest <> nil) and (errCount >= 1));
  513.   AResult := ATest.run;
  514.   try
  515.     Verify(AResult, 1, 0, errCount);
  516.   finally
  517.     AResult.Free
  518.   end
  519. end;
  521. procedure TVerifierTestCase.VerifyFailure(ATest: ITest);
  522. var
  523.   AResult: TTestResult;
  524. begin
  525.   assert(ATest <> nil);
  526.   // don't let ref counting free the test too early
  527.   AResult := ATest.run;
  528.   try
  529.     Verify(AResult, 1, 1, 0);
  530.   finally
  531.     AResult.Free;
  532.   end
  533. end;
  535. procedure TVerifierTestCase.VerifyLackOfSuccess(ATest: ITest);
  536. var
  537.   AResult: TTestResult;
  538. begin
  539.   assert(ATest <> nil);
  540.   AResult := ATest.run;
  541.   try
  542.     check(AResult.runCount = 1, 'wrong RunCount');
  543.     check((AResult.failureCount + AResult.errorCount) > 0, 'wrong Failures+Errors');
  544.     check(not AResult.wasSuccessful, 'should not have suceeded');
  545.   finally
  546.     AResult.Free;
  547.   end
  548. end;
  550. procedure TVerifierTestCase.VerifySuccess(ATest: ITest);
  551. var
  552.   AResult: TTestResult;
  553. begin
  554.   assert(ATest <> nil);
  555.   AResult := ATest.run;
  556.   try
  557.     Verify(AResult, 1, 0, 0);
  558.     check(AResult.wasSuccessful, 'should have suceeded');
  559.   finally
  560.     AResult.Free;
  561.   end
  562. end;
  564. procedure TVerifierTotalTestCase.VerifySuccess(ATest: ITest);
  565. var
  566.   AResult: TTestResult;
  567. begin
  568.   assert(ATest <> nil);
  569.   AResult := TTestResult.Create;
  570.   AResult.FailsIfNoChecksExecuted := ATest.FailsOnNoChecksExecuted;
  571.   AResult.FailsIfMemoryLeaked := ATest.FailsOnMemoryLeak;
  572.   AResult.IgnoresMemoryLeakInSetUpTearDown :=
  573.     ATest.IgnoreSetUpTearDownLeaks;
  574.   ATest.RunWithFixture(AResult);
  575.   try
  576.     Verify(AResult, 1, 0, 0);
  577.     check(AResult.wasSuccessful, 'should have suceeded');
  578.   finally
  579.     AResult.Free;
  580.   end
  581. end;
  583. procedure TVerifierTotalTestCase.VerifyFailure(ATest: ITest);
  584. var
  585.   AResult: TTestResult;
  586. begin
  587.   assert(ATest <> nil);
  588.   AResult := TTestResult.Create;
  589.   AResult.FailsIfNoChecksExecuted := ATest.FailsOnNoChecksExecuted;
  590.   AResult.FailsIfMemoryLeaked := ATest.FailsOnMemoryLeak;
  591.   ATest.RunWithFixture(AResult);
  592.   try
  593.     Verify(AResult, 1, 1, 0);
  594.   finally
  595.     AResult.Free;
  596.   end
  597. end;
  600. procedure TTestTest.TestBoolToStr;
  601. begin
  602.   CheckEqualsString('True',  BoolToStr(True),  'BoolToStr(True)');
  603.   CheckEqualsString('False', BoolToStr(False), 'BoolToStr(False)');
  604. end;
  608. procedure TTestTest.TestCheck;
  609. var
  610.   s1, s2, s3 :WideString;
  611. begin
  612.   Check(true, 'Check');
  613.   CheckEquals(1, 1,                   'CheckEquals    Integer');
  614.   CheckNotEquals(1, 2,                'CheckNotEquals Integer');
  615.   CheckEquals(1.0, 1.1, 0.15,         'CheckEquals    Double');
  616.   CheckNotEquals(1.0, 1.16, 0.15,     'CheckNotEquals Double');
  617.   CheckEqualsString('abc', 'abc',     'CheckEquals    String');
  618.   CheckNotEqualsString('abc', 'abcd', 'CheckNotEquals String');
  619.   CheckEquals(true, true,             'CheckEquals    Boolean');
  620.   CheckNotEquals(true, false,         'CheckNotEquals Boolean');
  622.   CheckEqualsBin(1, 1,                'CheckEqualsBin  Longword');
  623.   CheckNotEqualsBin(1, 2,             'CheckNotEqualsBin  Longword');
  624.   CheckEqualsHex(1, 1,                'CheckEqualsHex  Longword');
  625.   CheckNotEqualsHex(1, 2,             'CheckNotEqualsHex  Longword');
  627.   CheckNull(TObject(nil),        'CheckNull');
  628.   CheckNotNull(TObject(self),    'CheckNotNull object');
  629.   CheckSame(TObject(self), self, 'CheckSame    object');
  631.   // need the TTestCase(self) cast to work around Delphi typing quirks
  632.   CheckNull(TTEstCase(nil) as ITest,        'CheckNull');
  633.   CheckNotNull(TTestCase(self) as ITest,    'CheckNotNull interface');
  634.   CheckSame(TTestCase(self) as ITest, TTestCase(self) as ITest, 'CheckSame    interface');
  636.   CheckIs(self, TObject, 'self not a TObject');
  638.   s1 := 'aaa'#1024;
  639.   s2 := 'aaa';
  640.   s3 := 'bbb';
  642.   {$IFNDEF CLR}
  643.   CheckEqualsWideString(s1, s1, 'CheckEquals WideString');
  644.   CheckNotEqualsWideString(s1, s2, 'CheckNotEquals WideString');
  645.   CheckNotEqualsWideString(s2, s3, 'CheckNotEquals WideString');
  646.   {$ENDIF}
  648.   CheckTrue(true, 'CheckTrue');
  649.   CheckFalse(false, 'CheckFalse');
  650. end;
  652. procedure TTestTest.TestCheckEqualsBinHexMessage;
  654.   function ExpWas(msg, sExp, sAct: string):string;
  655.   begin
  656.     Result:=Format(sExpButWasFmt, [msg, sExp, sAct]);
  657.   end;
  659.   function BothAre(msg, sAct: string):string;
  660.   begin
  661.     Result:=Format(sExpAndActualFmt, [msg, sAct]);
  662.   end;
  664.   procedure CheckFailureMessage(ACheck:TCheckEqualsBinHex; iExp,iAct,dig:longword;
  665.                                 msg,ExpectedFailMsg:string);
  666.   begin
  667.     try
  668.       ACheck(iExp,iAct,msg,dig);
  669.       Assert(False,'Expected Failure: '+msg);
  670.     except
  671.       on E:ETestFailure do
  672.       begin
  673.         CheckEqualsString(ExpectedFailMsg,E.Message);
  674.       end;
  675.     end;
  676.   end;
  678. begin
  680.   // Check the binary string output:
  681.   CheckFailureMessage(CheckEqualsBin,0,1,1,'',ExpWas('','0','1')); // empty msg
  682.   CheckFailureMessage(CheckEqualsBin,0,15,4,'A1',ExpWas('A1, ','0000','1111'));
  683.   CheckFailureMessage(CheckEqualsBin,0,$55AA55AA,32,'B1',
  684.     ExpWas('B1, ','00000000000000000000000000000000',
  685.                   '01010101101010100101010110101010'));
  686.   CheckFailureMessage(CheckNotEqualsBin,3,3,2,'C1',BothAre('C1, ','11'));
  688.   // Check the Hex string output:
  689.   CheckFailureMessage(CheckEqualsHex,0,15,1,'A2',ExpWas('A2, ','0',IntToHex(15, 1)));
  690.   CheckFailureMessage(CheckEqualsHex,0,$55AA55AA,8,'B2',ExpWas('B2, ','00000000',IntToHex($55AA55AA, 8)));
  691.   CheckFailureMessage(CheckNotEqualsHex,999,999,4,'C2',BothAre('C2, ',IntToHex($03E7, 4)));
  693. end;
  695. {$IFNDEF CLR} // [KGS] don't expect CheckEquals(Mem) to work under CLR - pointers are unsafe
  696. procedure TTestTest.TestCheckEqualsMem; // Added KGS 06/06/2005
  697. // Tests TAbstractTest.CheckEqualsMem / CheckNotEqualsMem
  698. type TCheckEqualsMem = procedure(expected,actual:pointer; size:longword; msg:string) of object;
  699. var
  700.   a,b: byte;
  701.   x,y,z:Int64;
  702.   b1,b2: array[0..1023] of byte;
  703.   i: integer;
  705.   procedure CheckEqualsMemFailure(ACheck:TCheckEqualsMem; pExp,pAct:pointer;
  706.                                   size:longword; msg:string);
  707.   begin
  708.     try
  709.       ACheck(pExp,pAct,size,msg);
  710.       Assert(False,'Expected Failure: '+msg);
  711.     except
  712.       on E:ETestFailure do
  713.       begin
  714.         // we expected this!
  715.       end;
  716.     end;
  717.   end;
  719. begin
  721.   // 1. Test on a single byte:
  722.   a:=1;
  723.   b:=0;
  724.   CheckNotEqualsMem(@a,@b,1,'Missed Diff a<>b');
  725.   b:=a;
  726.   CheckEqualsMem(@a,@b,1,'False Diff a<>b');
  728.   // 2. Test 8-byte (Int64) fields:
  729.   x:=$123456789ABCDEF0;
  730.   y:=$123456789ABCDEF0;
  731.   z:=$023456789ABCDEF0; // differs in MSByte = last byte, offset 7
  732.   CheckEqualsMem(@x,@y,8,'False Diff x<>y');
  733.   CheckEqualsMem(@x,@z,7,'x<>z first 7');
  734.   CheckNotEqualsMem(@x,@z,8,'Failed to find x<>z');
  736.   // 3. Test on a 1KB byte-field:
  737.   for i:=0 to 1023 do b1[i]:=i and $FF; // test pattern
  738.   Move(b1[0],b2[0],1024); // copy b1 to b2 so should be identical
  739.   CheckEqualsMem(@b1[0],@b2[0],1024,'Diff b1<>b2');
  740.   // Induce an error:
  741.   Inc(b2[777]); // should create a discrepancy at offset 777
  742.   CheckEqualsMem(@b1[0],@b2[0],777,'First 777 still OK');
  743.   CheckNotEqualsMem(@b1[0],@b2[0],1023,'Induced error b1<>b2 not found');
  745.   // 4. Negative tests: These calls should fail! If they don't, it's an error.
  746.   CheckEqualsMemFailure(CheckNotEqualsMem,@a,@b,1,'Unexpected diff a<>b');
  747.   CheckEqualsMemFailure(CheckNotEqualsMem,@x,@y,8,'Unexpected diff x<>y');
  748.   CheckEqualsMemFailure(CheckNotEqualsMem,@x,@y,8,'Unexpected diff x<>y');
  749.   CheckEqualsMemFailure(CheckNotEqualsMem,@x,@z,7,'Unexpected diff x<>z, 7');
  750.   CheckEqualsMemFailure(CheckEqualsMem,@x,@z,8,'Expected diff x<>z, 8');
  751.   CheckEqualsMemFailure(CheckEqualsMem,@b1[0],@b2[0],1023,'Error b1<>b2 not found');
  753. end;
  755. procedure TTestTest.TestFirstByteDiff;
  756. // Tests TestFrameWork.FirstByteDiff function
  757. // (utility for Check(Not)EqualsMem failure reporting):
  758. var
  759.   a,b,val1,val2: byte;
  760.   x,z:Int64;
  761.   b1,b2: array[0..1023] of byte;
  762.   i: integer;
  763. begin
  764.   // 1. Test on a single byte:
  765.   a:=1;
  766.   b:=0;
  767.   CheckEquals(0,FirstByteDiff(@a,@b,1,val1,val2),'FirstDiff(a,b,1)');
  768.   CheckEquals(a,Val1,'a<>Val1');
  769.   CheckEquals(b,Val2,'b<>Val2');
  771.   // Try size=0: should yield -1
  772.   CheckEquals(-1,FirstByteDiff(@a,@b,0,val1,val2),'FirstDiff(size=0)');
  774.   b:=a; // Now return should be -1 because a=b
  775.   CheckEquals(-1,FirstByteDiff(@a,@b,1,val1,val2),'FirstDiff(a=b,1)');
  777.   // 2. Test 8-byte (Int64) fields:
  778.   x:=$123456789ABCDEF0;
  779.   z:=$023456789ABCDEF0; // differs in MSByte = last byte, offset 7
  780.   CheckEquals(7,FirstByteDiff(@x,@z,8,val1,val2),'FirstDiff(x,z,8)');
  781.   CheckEquals($12,val1,'x-val1');
  782.   CheckEquals($02,val2,'z-val2');
  784.   // 3. Test 1024-byte (1KB) field:
  785.   for i:=0 to 1023 do b1[i]:=i and $FF; // test pattern
  786.   Move(b1[0],b2[0],1024); // copy b1 to b2 so should be identical
  787.   // Induce an error:
  788.   Inc(b2[777]); // should create a discrepancy at offset 777
  789.   CheckEquals(777,FirstByteDiff(@b1[0],@b2[0],1024,val1,val2),'FirstDiff(b1,b2,1024)');
  790.   CheckEquals($09,val1,'b1-val1');
  791.   CheckEquals($0A,val2,'b2-val2');
  793. end;
  795. {$ENDIF} // for conditional No CLR
  797. procedure TTestTest.TestElapsedTestTime;
  798. const
  799.   DELAY = 50;
  800. var
  801.   t, min, max: Cardinal;
  802. begin
  803.   Sleep(DELAY);
  804.   min := (DELAY * 5)  div 10;
  805.   max := (DELAY * 15) div 10 + 1;
  806.   t := ElapsedTestTime;
  807.   check((t <= max), Format('Expected elapsed time to be less than or equal to %d but was %d', [max, t]));
  808.   check((t >= min), Format('Expected elapsed time to be greater than or equal to %d but was %d', [min, t]));
  809. end;
  811. procedure TTestTest.TestEmptyTestFailure;
  812. var
  813.   EmptyTest: TEmptyTest;
  814. begin
  815.   EmptyTest := TEmptyTest.Create('Test');
  816.   VerifyFailure(EmptyTest);
  817. end;
  819. procedure TTestTest.TestFailOnDisAllowedUnCalledCheck;
  820. var
  821.   EmptyTest: TEmptyTest;
  822. begin
  823.   EmptyTest := TEmptyTest.Create('NoChecksTest');
  824.   EmptyTest.FailsOnNoChecksExecuted := True;
  825.   VerifyFailure(EmptyTest);
  826. end;
  828. procedure TTestTest.TestPassOnAllowedUnCalledCheck;
  829. var
  830.   EmptyTest: TEmptyTest;
  831. begin
  832.   EmptyTest := TEmptyTest.Create('NoChecksTest');
  833.   EmptyTest.FailsOnNoChecksExecuted := False;
  834.   VerifySuccess(EmptyTest);
  835. end;
  837. procedure TTestTest.TestAlloweLeakListIterator;
  838. var  // Test based on current allowed array length of 4
  839.   ListIteratorValue: TListIterator;
  840.   Value: integer;
  841. begin
  842.   AllowedMemoryLeakSize := 44;
  843.   // Note. Using more values than necessary to show it's handled gracefully
  844.   SetAllowedLeakArray([3, 97, -10]);
  845.   Value := AllowedMemoryLeakSize;
  846.   Check(Value = 44, 'Should return 44 but returned ' +
  847.     IntToStr(Value));
  849.   ListIteratorValue := AllowedLeaksIterator;
  850.   Value := ListIteratorValue;
  851.   Check(Value = 44, 'ListIterator should return 44 but returned ' +
  852.     IntToStr(Value));
  853.   Value := ListIteratorValue;
  854.   Check(Value =  3, 'ListIterator should return 3 but returned ' +
  855.     IntToStr(Value));
  856.   Value := ListIteratorValue;
  857.   Check(Value = 97, 'ListIterator should return 97 but returned ' +
  858.     IntToStr(Value));
  859.   Value := ListIteratorValue;
  860.   Check(Value = -10, 'ListIterator should return -10 but returned ' +
  861.     IntToStr(Value));
  862.   Value := ListIteratorValue;
  863.   Check(Value =  0, 'ListIterator should return 0 but returned ' +
  864.     IntToStr(Value));
  865. end;
  867. procedure TTestTest.TestError;
  868. var
  869.   ErrorTestCase: TRunExceptionCase;
  870. begin
  871.   ErrorTestCase := TRunExceptionCase.Create('Test');
  872.   VerifyError(ErrorTestCase);
  873. end;
  875. procedure TTestTest.TestFailure;
  876. var
  877.   FailureTestCase: TRunFalseAssertCase;
  878. begin
  879.   FailureTestCase := TRunFalseAssertCase.Create('Test');
  880.   VerifyFailure(FailureTestCase);
  881. end;
  883. {$IFDEF VER130}
  884. // It is Delphi 5 so define the Supports function as it was not introduced until Delphi 6
  885. function Supports(const AClass: IUnknown; const IID: TGUID): Boolean;
  886. var
  887.   Intf: IUnknown;
  888. begin
  889.   Result := (AClass.QueryInterface(IID, Intf) = S_OK) and Assigned(Intf);
  890. end;
  891. {$ENDIF}
  893. procedure TTestTest.SetUp;
  894. var
  895.   SuiteOfTests : ITest;
  896. begin
  897.   inherited;
  898.   SuiteOfTests := nil;
  899.   SuiteOfTests := TestFramework.RegisteredTests;
  900.   Assert(SuiteOfTests <> nil);
  901.   Assert(Supports(SuiteOfTests, ITest));
  902.   fTestCount := SuiteOfTests.Tests.Count;
  903. end;
  905. procedure TTestTest.TearDown;
  906. var
  907.   SuiteOfTests : ITest;
  908. begin
  909.   inherited;
  910.   SuiteOfTests := TestFramework.RegisteredTests;
  911.   while ((SuiteOfTests <> nil) and (SuiteOfTests.Tests.Count > fTestCount)) do
  912.   begin
  913.     SuiteOfTests.Tests.Items[SuiteOfTests.Tests.Count-1] := nil;
  914.     SuiteOfTests.Tests.Delete(SuiteOfTests.Tests.Count-1);
  915.   end;
  916.   SuiteOfTests := nil;
  917. end;
  919. procedure TTestTest.TestRegisterTest;
  920. var
  921.   TestsRegistered: integer;
  922. begin
  923.   AllowedMemoryLeakSize := 56;
  924.   { test needs more work - the below passes, but it's not checking everything }
  925.   TestsRegistered := RegisteredTests.Tests.Count;
  927.   RegisterTest('', TSuccessCase.Suite);
  928.   Check((RegisteredTests.Tests[TestsRegistered] as ITest).name = 'TSuccessCase');
  930.   TestsRegistered := RegisteredTests.Tests.Count;
  931.   RegisterTest('Suite', TSuccessCase.Suite);
  932.   Check((RegisteredTests.Tests[TestsRegistered] as ITest).name = 'Suite');
  934.   RegisterTest('Suite.ChildA', TSuccessCase.Suite);
  935.   RegisterTest('Suite.ChildB', TSuccessCase.Suite);
  936. end;
  938. procedure TTestTest.TestRunAndTearDownFails;
  939. var
  940.   ATornDown: TRunAndTearDownException;
  941. begin
  942.   ATornDown := TRunAndTearDownException.Create('Test');
  943.   ATornDown._AddRef;
  944.   try
  945.     VerifyError(ATornDown, 2);
  946.     check(ATornDown.TornDown, 'not torn down');
  947.   finally
  948.     ATornDown._Release;
  949.   end
  950. end;
  952. procedure TTestTest.TestSetupException;
  953. var
  954.   ASetupException: TSetupException;
  955. begin
  956.   ASetupException := TSetupException.Create('Test');
  957.   VerifyError(ASetupException);
  958. end;
  960. procedure TTestTest.TestSuccess;
  961. var
  962.   ASuccessCase: TSuccessCase;
  963. begin
  964.   ASuccessCase := TSuccessCase.Create('Test');
  965.   VerifySuccess(ASuccessCase);
  966. end;
  968. procedure TTestTest.TestTearDownAfterError;
  969. var
  970.   ARunExceptionTornDown: TRunExceptionTornDown;
  971. begin
  972.   ARunExceptionTornDown := TRunExceptionTornDown.Create('Test');
  974.   ARunExceptionTornDown._AddRef;
  975.   try
  976.     VerifyError(ARunExceptionTornDown);
  977.     check(ARunExceptionTornDown.TornDown, 'not torn down');
  978.   finally
  979.     ARunExceptionTornDown._Release;
  980.   end;
  981. end;
  983. procedure TTestTest.TestTearDownFails;
  984. var
  985.   ATearDownException: TTearDownException;
  986. begin
  987.   ATearDownException := TTearDownException.Create('Test');
  988.   VerifyError(ATearDownException);
  989. end;
  991. procedure TTestTest.TestTearDownSetupFails;
  992. var
  993.   ASetupExceptionTornDown: TSetupExceptionTornDown;
  994. begin
  995.   ASetupExceptionTornDown := TSetupExceptionTornDown.Create('Test');
  997.   ASetupExceptionTornDown._AddRef;
  998.   try
  999.     VerifyError(ASetupExceptionTornDown);
  1000.     check(ASetupExceptionTornDown.TornDown);
  1001.   finally
  1002.     ASetupExceptionTornDown._Release
  1003.   end;
  1004. end;
  1006. procedure TTestTest.TestWasNotSuccessful;
  1007. var
  1008.   ARunExceptionCase: TRunExceptionCase;
  1009. begin
  1010.   ARunExceptionCase := TRunExceptionCase.Create('Test');
  1011.   VerifyLackOfSuccess(ARunExceptionCase);
  1012. end;
  1014. procedure TTestTest.TestWasStopped;
  1015. var
  1016.   AStopCase :ITest;
  1017.   AResult   :TTestResult;
  1018. begin
  1019.   AStopCase := TStopTest.Suite;
  1020.   AResult := AStopCase.run;
  1021.   try
  1022.     Verify(AResult, 3, 1, 0);
  1023.     check(AResult.WasStopped);
  1024.   finally
  1025.     AResult.Free
  1026.   end
  1027. end;
  1029. procedure TTestTest.TestWasSuccessful;
  1030. var
  1031.   ASuccessCase: TSuccessCase;
  1032. begin
  1033.   ASuccessCase := TSuccessCase.Create('Test');
  1034.   VerifySuccess(ASuccessCase);
  1035. end;
  1037. { TRunExceptionCase }
  1039. procedure TRunExceptionCase.Test;
  1040. begin
  1041.   raise EUnitTestException.Create('');
  1042. end;
  1044. { TRunFalseAssertCase }
  1046. procedure TRunFalseAssertCase.Test;
  1047. begin
  1048.   check(false);
  1049. end;
  1051. { TSetupException }
  1053. procedure TSetupException.SetUp;
  1054. begin
  1055.   raise EUnitTestException.Create('');
  1056. end;
  1058. procedure TSetupException.Test;
  1059. begin
  1060.   check(true);
  1061. end;
  1063. { TSuccessCase }
  1065. procedure TSuccessCase.Test;
  1066. begin
  1067.   check(true);
  1068. end;
  1070. procedure TFailsCase.Test;
  1071. begin
  1072.   Check(False);
  1073. end;
  1075. { TTearDownException }
  1077. procedure TTearDownException.TearDown;
  1078. begin
  1079.   raise EUnitTestException.Create('');
  1080. end;
  1082. { TSetupExceptionTornDown }
  1084. procedure TSetupExceptionTornDown.SetUp;
  1085. begin
  1086.   raise EUnitTestException.Create('');
  1087. end;
  1089. { TTestTestResult }
  1091. procedure TTestTestResult.SetUp;
  1092. begin
  1093.   FailsOnNoChecksExecuted := False;
  1094. end;
  1096. procedure TTestTestResult.TestElapsedTime;
  1097. var
  1098.   MockTimeSuite: ITest;
  1099.   ATestResult: TTestResult;
  1100. begin
  1101.   MockTimeSuite := TMockedTimeSuite.Create(TMockedTimeCase);
  1102.   ATestResult := nil;
  1103.   try
  1104.     ATestResult := MockTimeSuite.run;
  1105.     CheckEquals(3, ATestResult.TotalTime, 'TestResult.TotalTime');
  1106.   finally
  1107.     ATestResult.Free;
  1108.   end;
  1109. end;
  1111. procedure TTestTestResult.TestRun;
  1112. var
  1113.   ASuccessCase: ITest;
  1114.   ATestResult: TTestResult;
  1115. begin
  1116.   ASuccessCase := TSuccessCase.Create('Test');
  1117.   ATestResult := nil;
  1118.   try
  1119.     { TTestCase.run calls TTestResult.run. This test checks to ensure an
  1120.       AV bug in TTestResult.run is fixed.}
  1121.     ATestResult := ASuccessCase.run;
  1122.   finally
  1123.     ATestResult.Free;
  1124.   end;
  1125. end;
  1127. { TTestMethodEnumerator }
  1129. procedure TTestMethodEnumerator.TestMethodEnumerator;
  1130. const
  1131.   TotalMethods: integer = 3;
  1132. var
  1133.   i: integer;
  1134. begin
  1135.   FMethodEnumerator := TMethodEnumerator.Create(TTestMethodEnumClass);
  1136.   try
  1137.     check(FMethodEnumerator.MethodCount = TotalMethods);
  1138.     for i := 0 to TotalMethods - 1 do
  1139.       check(FMethodEnumerator.NameOfMethod[i] = 'Method' + IntToStr(i));
  1140.   finally
  1141.     FMethodEnumerator.Free;
  1142.   end;
  1143. end;
  1145. { TTestMethodEnumClass }
  1147. procedure TTestMethodEnumClass.Method0;
  1148. begin
  1149.   // do nothing, just used for TTestMethodEnumerator.TestMethodEnumerator
  1150. end;
  1152. procedure TTestMethodEnumClass.Method1;
  1153. begin
  1154.   // do nothing, just used for TTestMethodEnumerator.TestMethodEnumerator
  1155. end;
  1157. procedure TTestMethodEnumClass.Method2;
  1158. begin
  1159.   // do nothing, just used for TTestMethodEnumerator.TestMethodEnumerator
  1160. end;
  1162. { TStopTest }
  1164. procedure TStopTest.DoNothing;
  1165. begin
  1166.  // Stub so empty tests will not fail
  1167. end;
  1169. procedure TStopTest.doStop;
  1170. begin
  1171.   stopTests;
  1172. end;
  1174. procedure TStopTest.notExecutedOne;
  1175. begin
  1176.   DoNothing;
  1177. end;
  1179. procedure TStopTest.notExecutedTwo;
  1180. begin
  1181.   DoNothing;
  1182. end;
  1184. procedure TStopTest.testOne;
  1185. begin
  1186.   DoNothing;
  1187. end;
  1189. procedure TStopTest.testTwo;
  1190. begin
  1191.   DoNothing;
  1192. end;
  1194. { TExpectedTest }
  1196. procedure TExpectedTest.TestNotRaised;
  1197. begin
  1198.   StartExpectingException(EUnitTestException);
  1199.   StopExpectingException(ARBITRARY_STOPEXCEPT_MSG);
  1200. end;
  1202. procedure TExpectedTest.testRaised;
  1203. begin
  1204.   StartExpectingException(EUnitTestException);
  1205.   raise EUnitTestException.Create('testStartExpectingException');
  1206. end;
  1208. procedure TExpectedTest.testStart;
  1209. begin
  1210.   StopExpectingException;
  1211. end;
  1213. procedure TExpectedTest.testEnd;
  1214. begin
  1215.   StartExpectingException(EUnitTestException);
  1216. end;
  1218. { TEmptyTest }
  1220. {$IFOPT O-}
  1221. {$DEFINE UNOPTIMIZED}
  1222. {$OPTIMIZATION ON}
  1223. {$ENDIF}
  1224. procedure TEmptyTest.Test;
  1225. begin
  1226. // Test left intentionally empty
  1227. end;
  1228. {$IFDEF UNOPTIMIZED}
  1229. {$OPTIMIZATION OFF}
  1230. {$ENDIF}
  1232. {$IFOPT O+}
  1233. {$DEFINE OPTIMIZED}
  1234. {$OPTIMIZATION OFF}
  1235. {$ENDIF}
  1236. procedure TEmptyTest.NoChecksTest;
  1237. begin
  1238. // Test contains no executed calls to Check(...);
  1239. end;
  1240. {$IFDEF OPTIMIZED}
  1241. {$OPTIMIZATION ON}
  1242. {$ENDIF}
  1244. function TExpectedTest.RaiseException: Integer;
  1245. begin
  1246.   raise EUnitTestException.Create('testing exception');
  1247.   Result := 0;
  1248. end;
  1250. procedure TExpectedTest.RaiseExceptionProc;
  1251. begin
  1252.   RaiseException;
  1253. end;
  1255. procedure TExpectedTest.TestChecksAfterException;
  1256. begin
  1257.   StartExpectingException(EUnitTestException);
  1258.   CheckEquals(0, RaiseException, 'No error should have been reported');
  1259.   CheckEquals(0, RaiseException, 'This code is never reached! No error.');
  1260.   CheckEquals(0, 1, 'This code should never be reached!');
  1261. end;
  1264. procedure TExpectedTest.TestDifferentFromExpected;
  1265. begin
  1266.   StartExpectingException(ERangeError);
  1267.   CheckEquals(0, RaiseException, 'No error should have been reported');
  1268. end;
  1270. procedure TExpectedTest.TestInheritsFromExpected;
  1271. begin
  1272.   StartExpectingException(Exception);
  1273.   CheckEquals(0, RaiseException, 'No error should have been reported');
  1274. end;
  1276. procedure TExpectedTest.TestCheckException;
  1277. begin
  1278. {$IFDEF CLR}
  1279.   CheckException('RaiseExceptionProc', EUnitTestException);
  1280. {$ELSE}
  1281.   CheckException(RaiseExceptionProc, EUnitTestException);
  1282. {$ENDIF}
  1283. end;
  1285. procedure TExpectedTest.TestCheckWrongException;
  1286. begin
  1287. {$IFDEF CLR}
  1288.   CheckException('RaiseExceptionProc', ERangeError);
  1289. {$ELSE}
  1290.   CheckException(RaiseExceptionProc, ERangeError);
  1291. {$ENDIF}
  1292. end;
  1294. procedure TExpectedTest.TestNoExceptionRaised;
  1295. begin
  1296.   StartExpectingException(Exception);
  1297. end;
  1299. procedure TExpectedTest.DoNothing;
  1300. begin
  1301.   // nothing
  1302. end;
  1304. procedure TExpectedTest.testCheckAndNoExceptionRaised;
  1305. begin
  1306. {$IFDEF CLR}
  1307.   CheckException('DoNothing', Exception);
  1308. {$ELSE}
  1309.   CheckException(DoNothing, Exception);
  1310. {$ENDIF}
  1311. end;
  1313. { TTestExceptionChecks }
  1315. procedure TTestExceptionChecks.TestExpectedException;
  1316. var
  1317.   AExpectedCase :ITest;
  1318.   AResult   :TTestResult;
  1319. begin
  1320.   AExpectedCase := TExpectedTest.Suite;
  1321.   AResult := AExpectedCase.run;
  1322.   try
  1323.     Verify(AResult, AExpectedCase.CountEnabledTestCases, 6, 0);
  1324.   finally
  1325.     AResult.Free
  1326.   end
  1327. end;
  1330. procedure TTestExceptionChecks.TestIndividualException(AName: string; FailCnt, ErrCnt: Integer);
  1331. var
  1332.   AExpectedCase: ITest;
  1333.   AResult: TTestResult;
  1334. begin
  1335.   AExpectedCase := TExpectedTest.Create(AName);
  1336.   AResult := AExpectedCase.run;
  1337.   try
  1338.     Verify(AResult, 1, FailCnt, ErrCnt);
  1339.   finally
  1340.     AResult.Free
  1341.   end;
  1342. end;
  1344. procedure TTestExceptionChecks.TestCheckException;
  1345. begin
  1346.   TestIndividualException('TestCheckException', 0, 0);
  1347. end;
  1349. procedure TTestExceptionChecks.TestChecksAfterException;
  1350. begin
  1351.   TestIndividualException('TestChecksAfterException', 0, 0);
  1352. end;
  1354. procedure TTestExceptionChecks.TestCheckWrongException;
  1355. begin
  1356.   TestIndividualException('TestCheckWrongException', 1, 0);
  1357. end;
  1359. procedure TTestExceptionChecks.TestDifferentFromExpected;
  1360. begin
  1361.   TestIndividualException('TestDifferentFromExpected', 1, 0);
  1362. end;
  1364. procedure TTestExceptionChecks.TestInheritsFromExpected;
  1365. begin
  1366.   TestIndividualException('TestInheritsFromExpected', 0, 0);
  1367. end;
  1369. procedure TTestExceptionChecks.TestNoExceptionRaised;
  1370. begin
  1371.   TestIndividualException('TestNoExceptionRaised', 1, 0);
  1372. end;
  1374. procedure TTestExceptionChecks.TestCheckAndNoExceptionRaised;
  1375. begin
  1376.   TestIndividualException('TestCheckAndNoExceptionRaised', 1, 0);
  1377. end;
  1379. procedure TTestExceptionChecks.TestNotRaised;
  1380. var
  1381.   AExpectedCase :ITest;
  1382.   AResult   :TTestResult;
  1383. begin
  1384.   AExpectedCase := TExpectedTest.Create('TestNotRaised');
  1385.   AResult := AExpectedCase.run;
  1386.   try
  1387.     Verify(AResult, 1, 1, 0);
  1388.     CheckEqualsString( EXPECTED_STOPEXCEPT_MSG,
  1389.                  AResult.Failures[0].ThrownExceptionMessage,
  1390.                  'wrong message thrown from StopExpectingException');
  1391.   finally
  1392.     AResult.Free
  1393.   end;
  1394. end;
  1396. { TTestWthStatusMsgs }
  1398. procedure TTestWithStatusMsgs.Test;
  1399. begin
  1400.   Status('Line 1');
  1401.   Status('Line 2');
  1402.   Status('Line 3');
  1403. end;
  1405. { TTestStatus }
  1407. procedure TTestStatus.testStatus;
  1408. var
  1409.   AStatusCase: TTestWithStatusMsgs;
  1410. const
  1411. {$IFDEF WIN32}
  1412.   constLineDelim = #13#10;
  1413. {$ENDIF}
  1414. {$IFDEF CLR}
  1415.   constLineDelim = #13#10;
  1416. {$ENDIF}
  1417. {$IFDEF LINUX}
  1418.   constLineDelim = #10;
  1419. {$ENDIF}
  1420.   constStatusTestStr =
  1421.       'Line 1' + constLineDelim
  1422.       + 'Line 2' + constLineDelim
  1423.       + 'Line 3' + constLineDelim;
  1424. begin
  1425.   AStatusCase := TTestWithStatusMsgs.Create('Test');
  1426.   try
  1427.     AStatusCase._AddRef;
  1428.     VerifySuccess(AStatusCase);
  1430.     CheckEqualsString(AStatusCase.getStatus, constStatusTestStr,
  1431.       'Status not correctly validated in test');
  1432.   finally
  1433.     AStatusCase._Release;
  1434.   end;
  1435. end;
  1437. { TFixtureSuite }
  1439. procedure TFixtureSuite.SetUp;
  1440. begin
  1441.   inherited;
  1442.   SetUpCalled := true;
  1443. end;
  1445. procedure TFixtureSuite.TearDown;
  1446. begin
  1447.   TearDownCalled := true;
  1448.   inherited;
  1449. end;
  1451. { TTestTestSuite }
  1453. procedure TTestTestSuite.TestSuiteSetupTearDown;
  1454. var
  1455.   AFixtureSuite: TFixtureSuite;
  1456. begin
  1457.   AFixtureSuite := TFixtureSuite.Create('Fixture Suite');
  1458. {$IFNDEF CLR}
  1459.   AFixtureSuite._AddRef;
  1460. {$ENDIF}
  1461.   try
  1462.     AFixtureSuite.AddTests(TSuccessCase);
  1463.     VerifySuccess(AFixtureSuite);
  1464.     CheckEquals(true, AFixtureSuite.SetUpCalled, 'Suite SetUp called');
  1465.     CheckEquals(true, AFixtureSuite.TearDownCalled, 'Suite TearDown called');
  1466.   finally
  1467. {$IFNDEF CLR}
  1468.     AFixtureSuite._Release;
  1469. {$ENDIF}
  1470.   end;
  1471. end;
  1473. { TMockedTimeCase }
  1475. function TMockedTimeCase.ElapsedTestTime: Cardinal;
  1476. begin
  1477.   Result := 1;
  1478. end;
  1480. procedure TMockedTimeCase.SuccessOne;
  1481. begin
  1482.   Check(true);
  1483. end;
  1485. procedure TMockedTimeCase.SuccessTwo;
  1486. begin
  1487.   Check(true);
  1488. end;
  1490. { TMockedTimeSuite }
  1492. function TMockedTimeSuite.ElapsedTestTime: Cardinal;
  1493. begin
  1494.   Result := 3;
  1495. end;
  1497. procedure TTestMemLeakTestSuite.SetUp;
  1498. var
  1499.   SuiteOfTests : ITest;
  1500. begin
  1501.   inherited;
  1502.   SuiteOfTests := nil;
  1503.   SuiteOfTests := TestFramework.RegisteredTests;
  1504.   Assert(SuiteOfTests <> nil);
  1505.   Assert(Supports(SuiteOfTests, ITest));
  1506.   fTestCount := SuiteOfTests.Tests.Count;
  1507.   FreeAndNil(AnObject);
  1508. end;
  1510. procedure TTestMemLeakTestSuite.TearDown;
  1511. var
  1512.   SuiteOfTests : ITest;
  1513. begin
  1514.   inherited;
  1515.   SuiteOfTests := nil;
  1516.   SuiteOfTests := TestFramework.RegisteredTests;
  1517.   while ((SuiteOfTests <> nil) and (SuiteOfTests.Tests.Count > fTestCount)) do
  1518.   begin
  1519.     SuiteOfTests.Tests.Items[SuiteOfTests.Tests.Count-1] := nil;
  1520.     SuiteOfTests.Tests.Delete(SuiteOfTests.Tests.Count-1);
  1521.   end;
  1522.   FreeAndNil(AnObject);
  1523. end;
  1525. procedure TTestMemLeakTestSuite.TestClassCanDetectFailure;
  1526. var
  1527.   TestWillFail: TFailsCase;
  1528. begin
  1529. {$IFDEF CLR}
  1530.   Check(True);
  1531. {$ELSE}
  1532.   {$IFDEF VER180}
  1533.     Check(not IsMemoryManagerSet, 'Unknown Memory Manager loaded');
  1534.   {$ELSE}
  1535.   Check(IsMemoryManagerSet, 'Memory Manager not loaded');
  1536.   {$ENDIF}
  1537. {$ENDIF}
  1538.   TestWillFail := TFailsCase.Create('Test');
  1539.   TestWillFail.FailsOnMemoryLeak := True;
  1540.   VerifyFailure(TestWillFail);
  1541. end;
  1543. procedure TTestMemLeakTestSuite.TestCaseDoesNotLeak;
  1544. var
  1545.   LeakyTest: TLeakyTest;
  1546. begin
  1547.   LeakyTest := TLeakyTest.Create('TestDoesNotLeak');
  1548.   LeakyTest.FailsOnMemoryLeak := True;
  1549.   VerifySuccess(LeakyTest);
  1550.   FreeAndNil(AnObject);
  1551. end;
  1553. procedure TTestMemLeakTestSuite.TestCaseLeaksTObject;
  1554. var
  1555.   LeakyTest: TLeakyTest;
  1556. begin
  1557.   LeakyTest := TLeakyTest.Create('TestContainsTObjectLeak');
  1558.   LeakyTest.FailsOnMemoryLeak := True;
  1559.   VerifyFailure(LeakyTest);
  1560.   FreeAndNil(AnObject);
  1561. end;
  1563. procedure TTestMemLeakTestSuite.TestCaseLeaksTObjectReportDisabled;
  1564. var
  1565.   LeakyTest: TLeakyTest;
  1566. begin
  1567.   LeakyTest := TLeakyTest.Create('TestContainsTObjectLeak');
  1568.   LeakyTest.FailsOnMemoryLeak := False;
  1569.   VerifySuccess(LeakyTest);
  1570.   FreeAndNil(AnObject);
  1571. end;
  1573. procedure TTestMemLeakTestSuite.TestCaseLeaksTObjectLeakOfSizeAllowed;
  1574. var
  1575.   LeakyTest: TLeakyTest;
  1576. begin
  1577.   LeakyTest := TLeakyTest.Create('TestContainsAllowedTObjectLeak');
  1578.   LeakyTest.FailsOnMemoryLeak := True;
  1579.   VerifySuccess(LeakyTest);
  1580.   FreeAndNil(AnObject);
  1581. end;
  1583. procedure TTestMemLeakTestSuite.TestCaseLeaksTObjectLeakOfListSizeAllowed;
  1584. var
  1585.   LeakyTest: TLeakyTest;
  1586. begin
  1587.   LeakyTest := TLeakyTest.Create('TestContainsAllowedTObjectLeakByList');
  1588.   LeakyTest.FailsOnMemoryLeak := True;
  1589.   VerifySuccess(LeakyTest);
  1590.   FreeAndNil(AnObject);
  1591. end;
  1593. procedure TTestMemLeakTestSuite.TestCaseLeaksAllowedTObjectLeakOfEmptyList;
  1594. var
  1595.   LeakyTest: TLeakyTest;
  1596. begin
  1597.   LeakyTest := TLeakyTest.Create('TestContainsAllowedTObjectLeakByEmptyList');
  1598.   LeakyTest.FailsOnMemoryLeak := True;
  1599.   VerifySuccess(LeakyTest);
  1600.   FreeAndNil(AnObject);
  1601. end;
  1603. procedure TTestMemLeakTestSuite.TestCaseFailsOnOverSizeAllowedLeakArrayList;
  1604. var
  1605.   LeakyTest: TLeakyTest;
  1606. begin
  1607.   LeakyTest := TLeakyTest.Create('TestContainsAllowedLeakArrayLongList');
  1608.   LeakyTest.FailsOnMemoryLeak := True;
  1609.   VerifyLackOfSuccess(LeakyTest);
  1610.   FreeAndNil(AnObject);
  1611. end;
  1613. procedure TTestMemLeakTestSuite.TestCaseNoLeaksAtSetupTearDownLevel;
  1614. var
  1615.   LeakyTest: TLeakySetupTearDown;
  1616. begin
  1617.   LeakyTest := TLeakySetupTearDown.Create('TestSetupTearDownLeakDetect');
  1618.   LeakyTest.FailsOnMemoryLeak := True;
  1619.   VerifyFailure(LeakyTest);
  1620.   FreeAndNil(AnObject);
  1621. end;
  1623. procedure TTestMemLeakTestSuite.TestCaseLeaksAtSetupTearDownLevel;
  1624. var
  1625.   LeakyTest: TLeakySetupTearDown;
  1627. begin
  1628.   LeakyTest := TLeakySetupTearDown.Create('TestSetupTearDownLeakDetect');
  1629.   LeakyTest.FailsOnMemoryLeak := True;
  1630.   VerifyFailure(LeakyTest);
  1631.   FreeAndNil(AnObject);
  1632. end;
  1634. procedure TTestMemLeakTestSuite.TestCaseIgnoresLeaksAtSetupTearDownLevel;
  1635. var
  1636.   LeakyTest: TLeakySetupTearDown;
  1638. begin
  1639.   LeakyTest := TLeakySetupTearDown.Create('TestSetupTearDownLeakDetect');
  1640.   LeakyTest.FailsOnMemoryLeak := True;
  1641.   LeakyTest.IgnoreSetUpTearDownLeaks:= True;
  1642.   VerifySuccess(LeakyTest);
  1643.   FreeAndNil(AnObject);
  1644. end;
  1646. procedure TTestMemLeakTestSuite.TestCaseDoesNotIgnoreLeaksInTestProc;
  1647. var
  1648.   LeakyTest: TLeakyTest;
  1650. begin
  1651.   LeakyTest := TLeakyTest.Create('TestContainsTObjectLeak');
  1652.   LeakyTest.FailsOnMemoryLeak := True;
  1653.   LeakyTest.IgnoreSetUpTearDownLeaks:= True;
  1654.   VerifyFailure(LeakyTest);
  1655.   FreeAndNil(AnObject);
  1656. end;
  1658. procedure TLeakyTest.Setup;
  1659. begin
  1660.   FailsOnNoChecksExecuted := False;
  1661. end;
  1663. procedure TLeakyTest.TestDoesNotLeak;
  1664. begin
  1665.   Check(True, 'Test does not leak and never fails');
  1666. end;
  1668. procedure TLeakyTest.TestContainsTObjectLeak;
  1669. begin
  1670.   AnObject := TObject.Create;
  1671. end;
  1673. procedure TLeakyTest.TestContainsAllowedTObjectLeak;
  1674. begin
  1675.   AnObject := TObject.Create;
  1676.   AllowedMemoryLeakSize := 16;
  1677. end;
  1679. procedure TLeakyTest.TestContainsAllowedTObjectLeakByList;
  1680. begin
  1681.   AnObject := TObject.Create;
  1682.   SetAllowedLeakArray([1, 7, 16]);
  1683. end;
  1685. procedure TLeakyTest.TestContainsAllowedTObjectLeakByEmptyList;
  1686. begin
  1687.   AnObject := TObject.Create;
  1688.   AllowedMemoryLeakSize := 16;
  1689.   SetAllowedLeakArray([]);
  1690. end;
  1692. procedure TLeakyTest.TestContainsAllowedLeakArrayLongList;
  1693. begin
  1694.   AnObject := TObject.Create;
  1695.   SetAllowedLeakArray([1, 7, 16, 55]);  // causes deliberate failure
  1696. end;
  1698. procedure TLeakySetupTearDown.SetUp;
  1699. begin
  1700.   AnObject := TObject.Create;
  1701. end;
  1703. procedure TLeakySetupTearDown.TearDown;
  1704. begin
  1705.   if FreeInTearDown then
  1706.     FreeAndNil(AnObject);
  1707. end;
  1709. procedure TLeakySetupTearDown.TestCaseDoesNotLeak;
  1710. begin
  1711.   FreeInTearDown := True;
  1712.   Check(Assigned(AnObject), 'Object should be Assigned');
  1713. end;
  1715. procedure TLeakySetupTearDown.TestSetupTearDownLeakDetect;
  1716. begin
  1717.   // Dont allow TearDown to free object created in SetUp.
  1718.   // Cause mem leak at teardown phase.
  1719.   FreeInTearDown := false;
  1720.   Check(Assigned(AnObject), 'Object should be Assigned');
  1721. end;
  1723. { TTestBasicTestCase4Leaks }
  1725. type
  1726.   TTiny1 = class(TTestCase)
  1727.   private
  1728.     FTestRan: boolean;
  1729.   public
  1730.     constructor Create(MethodName: string); override;
  1731.     destructor Destroy; override;
  1732.   published
  1733.     procedure NonEmptyProc;
  1734.   end;
  1736.   TTiny2 = class(TTestCase)
  1737.   private
  1738.     FTestRan: boolean;
  1739.   public
  1740.     constructor Create(MethodName: string); override;
  1741.     destructor Destroy; override;
  1742.   published
  1743.     procedure NonEmptyProc;
  1744.   end;
  1746. constructor TTiny1.Create(MethodName: string);
  1747. begin
  1748.   inherited Create(MethodName);
  1749. end;
  1751. destructor TTiny1.Destroy;
  1752. begin
  1753.   inherited;
  1754. end;
  1756. procedure TTiny1.NonEmptyProc;
  1757. begin
  1758.   FTestRan := True;
  1759. end;
  1761. constructor TTiny2.Create(MethodName: string);
  1762. begin
  1763.   inherited Create(MethodName);
  1764. end;
  1766. destructor TTiny2.Destroy;
  1767. begin
  1768.   inherited;
  1769. end;
  1771. procedure TTiny2.NonEmptyProc;
  1772. begin
  1773.   FTestRan := True;
  1774. end;
  1776. procedure TTestBasicTestCase4Leaks.TestCheckIfTAbstractTestLeaks;
  1777. var
  1778.   TrialTest: TAbstractTest;
  1779.   MLM: IMemLeakMonitor;
  1780.   LeakSize: integer;
  1781. begin
  1782.   MLM := MemLeakMonitor;
  1783.   TrialTest := TAbstractTest.Create('ABCDEFG12345');
  1784.   FreeAndNil(TrialTest);
  1785.   Check(not MLM.MemLeakDetected(LeakSize),
  1786.     'Named TAbstractTest leaks ' + IntToStr(LeakSize) + ' Bytes');
  1787.   MLM := nil;
  1788. end;
  1790. procedure TTestBasicTestCase4Leaks.TestCheckIfTTestCaseLeaks;
  1791. var
  1792.   TrialTestCase: TTiny1;
  1793.   MLM: IMemLeakMonitor;
  1794.   LeakSize: integer;
  1795. begin
  1796.   MLM := MemLeakMonitor;
  1797.   TrialTestCase := TTiny1.Create('NonEmptyProc');
  1798.   FreeAndNil(TrialTestCase);
  1799.   Check(not MLM.MemLeakDetected(LeakSize), 'TTiny1 leaks '
  1800.     + IntToStr(LeakSize) + ' Bytes');
  1801.   MLM := nil;
  1802. end;
  1804. procedure TTestBasicTestCase4Leaks.TestCheckIfTTestResultLeaks;
  1805. var
  1806.   TrialTestResult: TTestResult;
  1807.   MLM: IMemLeakMonitor;
  1808.   LeakSize: integer;
  1809. begin
  1810.   MLM := MemLeakMonitor;
  1811.   TrialTestResult := TTestResult.Create;
  1812.   FreeAndNil(TrialTestResult);
  1813.   Check(not MLM.MemLeakDetected(LeakSize), 'TTestResult leaks '
  1814.     + IntToStr(LeakSize) + ' Bytes');
  1815.   MLM := nil;
  1816. end;
  1818. procedure TTestBasicTestCase4Leaks.TestCheckIfTStatusListnerLeaks;
  1819. var
  1820.   TrialStatusListner: IStatusListener;
  1821.   TrialTestResult: TTestResult;
  1822.   MLM: IMemLeakMonitor;
  1823.   LeakSize: integer;
  1824. begin
  1825.   TrialTestResult := nil;
  1826.   try
  1827.     TrialTestResult := TTestResult.Create;
  1828.     MLM := MemLeakMonitor;
  1829.     TrialStatusListner := TStatusToResultAdapter.Create(TrialTestResult);
  1830.     Check(Assigned(TrialStatusListner), 'Failed to create TStatusToResultAdapter');
  1831.     TrialStatusListner := nil;
  1832.     Check(not MLM.MemLeakDetected(LeakSize), 'IStatusListener leaks '
  1833.       + IntToStr(LeakSize) + ' Bytes');
  1834.     MLM := nil;
  1835.   finally
  1836.     FreeAndNil(TrialTestResult);
  1837.   end;
  1838. end;
  1840. procedure TTestBasicTestCase4Leaks.TestCheckIfTTestFalureLeaks;
  1841. var
  1842.   TrialTestFailure: TTestFailure;
  1843.   MLM: IMemLeakMonitor;
  1844.   LeakSize: integer;
  1845.   TrialTestCase: TTiny1;
  1846. begin
  1847.   MLM := MemLeakMonitor;
  1848.   TrialTestCase := TTiny1.Create('NonEmptyProc');
  1849.   TrialTestFailure := TTestFailure.Create(TrialTestCase, nil, 'A String');
  1850.   FreeAndNil(TrialTestFailure); // Note. Seems to free TrialTestCase early.
  1851.   Check(not MLM.MemLeakDetected(LeakSize), 'TTestFailure leaks '
  1852.     + IntToStr(LeakSize) + ' Bytes');
  1853.   MLM := nil;
  1854. end;
  1856. procedure TTestBasicTestCase4Leaks.TestCheckIfRunTTestCaseLeaks;
  1857. var
  1858.   TrialTestCase: TTiny1;
  1859.   TrialTestResult: TTestResult;
  1860.   MLM: IMemLeakMonitor;
  1861.   LeakSize: integer;
  1862. begin
  1863.   MLM := MemLeakMonitor;
  1864.   TrialTestCase := TTiny1.Create('NonEmptyProc');
  1865.   TrialTestResult := TTestResult.Create;
  1866.   TrialTestResult.RunSuite(TrialTestCase);
  1867.   FreeAndNil(TrialTestResult);
  1868.   Check(not MLM.MemLeakDetected(LeakSize), 'TTiny1 leaks '
  1869.     + IntToStr(LeakSize) + ' Bytes');
  1870.   MLM := nil;
  1871. end;
  1873. procedure TTestBasicTestCase4Leaks.TestCheckIfEnumeratorLeaks;
  1874. var
  1875.   MLM: IMemLeakMonitor;
  1876.   LeakSize: integer;
  1877.   TrialEnumerator: TMethodEnumerator;
  1878. begin
  1879.   MLM := MemLeakMonitor;
  1880.   TrialEnumerator := TMethodEnumerator.Create(TTiny1);
  1881.   FreeAndNil(TrialEnumerator);
  1882.   Check(not MLM.MemLeakDetected(LeakSize), 'TrialEnumerator leaks '
  1883.     + IntToStr(LeakSize) + ' Bytes');
  1884.   MLM := nil;
  1885. end;
  1887. procedure TTestBasicTestCase4Leaks.TestCheckIfITestSuiteLeaks;
  1888. var
  1889.   MLM: IMemLeakMonitor;
  1890.   LeakSize: integer;
  1891.   TrialTestSuite: ITestSuite;
  1893. // Suite creation put inside local procedure to provide an end statement to
  1894. // hit before the memory difference is computed.
  1895. // This is believed to be due to the suite ref creation in TestFramework
  1896. // <function TestSuite(name: string; const Tests: array of ITest): ITestSuite;>
  1897. // Free up of interfaced refs needs a end statement to complete mem release.
  1899.   procedure LRunTest;
  1900.   begin
  1901.     TrialTestSuite := TestSuite('MyTestSuite', [TTiny1.Suite, TTiny2.Suite]);
  1902.     TrialTestSuite := nil;
  1903.   end;
  1905. begin
  1906.   MLM := MemLeakMonitor;
  1907.   LRunTest;
  1908.   Check(not MLM.MemLeakDetected(LeakSize), 'TrialTestSuite leaks '
  1909.     + IntToStr(LeakSize) + ' Bytes');
  1910.   MLM := nil;
  1911. end;
  1913. initialization
  1914.   RegisterTests('Framework Suites',[TTestTest.Suite,
  1915.                                     TTestTestResult.Suite,
  1916.                                     TTestStatus.Suite,
  1917.                                     TTestMethodEnumerator.Suite,
  1918.                                     TTestExceptionChecks.Suite,
  1919. {$IFDEF DETECTMEMLEAKS}
  1920.                                     TBasicMemMonitor.Suite,
  1921.                                     TMemMonitorGetErrorMessage.Suite,
  1922.                                     TMemMonitorGetErrorMessageNew.Suite,
  1923.                                     TTestMemLeakTestSuite.Suite,
  1924.                                     TTestBasicTestCase4Leaks.Suite,
  1925. {$ENDIF}
  1926.                                     TTestTestSuite.Suite]);
  1927. end.