{#(@)$Id: TestFramework.pas,v 1.2 2005/10/06 16:48:49 timop Exp $ }
{  DUnit: An XTreme testing framework for Delphi programs. }
(*
 * The contents of this file are subject to the Mozilla Public
 * License Version 1.1 (the "License"); you may not use this file
 * except in compliance with the License. You may obtain a copy of
 * the License at http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS
 * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 * implied. See the License for the specific language governing
 * rights and limitations under the License.
 *
 * The Original Code is DUnit.
 *
 * The Initial Developers of the Original Code are Kent Beck, Erich Gamma,
 * and Juancarlo Aņez.
 * Portions created The Initial Developers are Copyright (C) 1999-2000.
 * Portions created by The DUnit Group are Copyright (C) 2000-2004.
 * All rights reserved.
 *
 * Contributor(s):
 * Kent Beck 
 * Erich Gamma 
 * Juanco Aņez 
 * Chris Morris 
 * Jeff Moore 
 * Uberto Barbini 
 * Brett Shearer 
 * Kris Golko 
 * The DUnit group at SourceForge 
 *
 *)

{$IFDEF CLR}
  {$UNSAFECODE ON}
{$ENDIF}
{$BOOLEVAL OFF}
unit TestFramework;

interface

uses 
{$IFDEF CLR} System.Reflection,{$ENDIF}
	System.Collections;

const
  rcs_id: string = '#(@)$Id: TestFramework.pas,v 1.2 2005/10/06 16:48:49 timop Exp $';
  rcs_verion : string = '$Revision: 1.2 $';

type EAbort = class(Exception) end;

type
{$IFDEF CLR}
  IUnknown = interface(IInterface)
  end;
  TestAttribute = class(System.Attribute)
  end;
{$ENDIF}

{$IFDEF CLR}
  TTestMethod  = string;
{$ELSE}
  TTestMethod  = procedure of object;
{$ENDIF}
  TTestProc    = procedure;

  TTestCaseClass  = class of TTestCase;

  ITestListener   = interface;
  IStatusListener = interface;

  TTestResult   = class;
  TAbstractTest = class;
  TTestCase     = class;
  TTestSuite    = class;
  TTestFailure  = class;

  ExceptionClass = class of Exception;

  ETestFailure = class(EAbort)
     constructor Create;               overload;
     constructor Create(msg :string);  overload;
  end;

  EDunitException = class(Exception);
  ETestError = class(EDunitException);
  EStopTestsFailure = class(ETestFailure);


  { thrown to force a debugger break on a test failure }
  EBreakingTestFailure = class(EDunitException)
     constructor Create;               overload;
     constructor Create(msg :string);  overload;
  end;


  ITest = interface(IUnknown)
    ['{89CCD557-7DE1-4814-B033-ABAFE0870EC7}']
    function get_Name: string;

    function  CountTestCases: integer;
    function  CountEnabledTestCases: integer;
    function  Tests: ArrayList;


    procedure SetUp;
    procedure TearDown;

    function  Run : TTestResult;  overload;
    procedure Run(testResult: TTestResult); overload;

    procedure RunWithFixture(testResult: TTestResult);
    procedure RunTest(testResult: TTestResult);

    function  get_Enabled: boolean;
    procedure set_Enabled(Value: boolean);

    procedure set_StartTime(Value :System.DateTime);
    function  get_StartTime : System.DateTime;

    procedure set_StopTime(Value :System.DateTime);
    function  get_StopTime : System.DateTime;
    function  ElapsedTestTime: System.Int64;


    procedure SetStatusListener(Listener :IStatusListener);
    function  get_Status :string;

    procedure set_GUIObject(const guiObject: TObject);
    function  get_GUIObject: TObject;

    property Name:    string  read get_Name;
    property Enabled: boolean read get_Enabled write set_Enabled;
    property GUIObject: TObject read get_GUIObject write set_GUIObject;
    property Status:  string  read get_Status;

    property StartTime: System.DateTime read get_StartTime write set_StartTime;
    property StopTime:  System.DateTime read get_StopTime  write set_StopTime;
  end;


  {: General interface for test decorators}
  ITestDecorator = interface(ITest)
    ['{8B3FC229-3033-4590-AD5C-01914C6E2C9F}']
    {: Get the decorated test
    @return The decorated test }
    function get_Test: ITest;
    property Test: ITest read get_Test;
  end;

  { IStatusListeners are notified of test status messages }
  IStatusListener = interface
  ['{8681DC88-033C-4A42-84F4-4C52EF9ABAC0}']
    procedure Status(test :ITest; const Msg :string);
    procedure Warning(test: ITest; const Msg: string);
  end;

  { ITestListeners get notified of testing events.
    See TTestResult.AddListener()
  }
  ITestListener = interface(IStatusListener)
    ['{114185BC-B36B-4C68-BDAB-273DBD450F72}']

    procedure TestingStarts;
    procedure StartTest(test: ITest);

    procedure AddSuccess(test: ITest);
    procedure AddError(error: TTestFailure);
    procedure AddFailure(Failure: TTestFailure);

    procedure EndTest(test: ITest);
    procedure TestingEnds(testResult :TTestResult);

    function  ShouldRunTest(test :ITest):boolean;
  end;


  ITestListenerX = interface(ITestListener)
    ['{5C28B1BE-38B5-4D6F-AA96-A04E9302C317}']

    procedure StartSuite(suite: ITest);
    procedure EndSuite(suite: ITest);
  end;

  // a named collection of tests
  ITestSuite = interface(ITest)
    ['{C20E38EF-7369-44D9-9D84-08E84EC1DCF0}']

    procedure AddTest(test: ITest);
    procedure AddSuite(suite : ITestSuite);
  end;

  {  Adapter to allow a TTestResult to receive status messages
     from the running test }
  TStatusToResultAdapter = class(TInterfacedObject, IStatusListener)
  protected
    FTestResult :TTestResult;
  public
    constructor Create(TestResult :TTestResult);
    procedure   Status(Test :ITest; const Msg :string);
    procedure   Warning(Test: ITest; const Msg: string);
  end;

  { A TTestResult collects the results of executing a test case.
  And notifies registered ITestListener of testing events. }
  TTestResult = class(TObject)
  private
    FTotalTime: Int64;
  protected
    fFailures: ArrayList;
    fErrors: ArrayList;
    fWarnings: ArrayList;
    fListeners: ArrayList;
    FRootTest: ITest;
    fRunTests: integer;
    fStop: boolean;
    FBreakOnFailures :boolean;

    FStatusAdapter :IStatusListener;

    procedure Run(test: ITest); virtual;
    function  RunTestSetup(test: ITest):boolean; virtual;
    procedure RunTestTearDown(test: ITest); virtual;
    function  RunTestRun(test: ITest) : boolean; virtual;

    procedure TestingStarts;                           virtual;
    procedure StartSuite(suite: ITest);                virtual;
    procedure StartTest(test: ITest);                  virtual;
    function  ShouldRunTest(test :ITest) :boolean;     virtual;
    procedure Status(test :ITest; const Msg :string);  virtual;
    procedure Warning(test: ITest; const Msg: string); virtual;
    procedure EndSuite(suite: ITest);                  virtual;
    procedure EndTest(test: ITest);                    virtual;
    procedure TestingEnds;                             virtual;
  public

    constructor Create;
    destructor  Destroy; override;

    procedure AddListener(listener: ITestListener); virtual;

    procedure RunSuite(test: ITest);  overload;
    procedure AddSuccess(test: ITest);                                                              virtual;
    function  AddFailure(test: ITest; e: Exception): TTestFailure;                   virtual;
    function  AddError(  test: ITest; e: Exception; msg :string = ''): TTestFailure; virtual;


    procedure Stop; virtual;
    function  ShouldStop: boolean; virtual;

    function RunCount: System.Int16;     virtual;
    function ErrorCount: System.Int16;   virtual;
    function FailureCount: System.Int16; virtual;
    function WarningCount: System.Int16; virtual;

    function  GetError(Index :Integer) :TTestFailure;
    function  GetFailure(Index :Integer) :TTestFailure;
    function  GetWarning(Index :Integer) :string;

    function  WasStopped :boolean; virtual;
    function  WasSuccessful: boolean; virtual;

    property  BreakOnFailures :boolean read  FBreakOnFailures write FBreakOnFailures;
    property  TotalTime: Int64 read FTotalTime;

    property Errors[i :Integer] :TTestFailure read GetError;
    property Failures[i :Integer] :TTestFailure read GetFailure;
    property Warnings[i :Integer] :string read GetWarning;
  end;


  TAbstractTest = class(TInterfacedObject, ITest)
  protected
    FTestName: string;
    fEnabled: boolean;

    fStartTime: System.DateTime;
    fStopTime:  System.DateTime;

    FStatusListener :IStatusListener;
    FStatusStrings  :ArrayList;

    FExpectedException: ExceptionClass;

    // Object used by the GUI to map the test onto a GUI object such as a tree node
    FGUIObject: TObject;

    procedure Invoke(AMethod: TTestMethod); virtual;
    procedure RunWithFixture(testResult: TTestResult); virtual;
    procedure RunTest(testResult: TTestResult); virtual;

    procedure SetUp; virtual;
    procedure TearDown; virtual;

    procedure set_StartTime(Value :System.DateTime); virtual;
    function  get_StartTime : System.DateTime;       virtual;

    procedure set_StopTime(Value :System.DateTime);  virtual;
    function  get_StopTime : System.DateTime;        virtual;

    procedure set_GUIObject(const guiObject: TObject);
    function  get_GUIObject: TObject;

  public
    constructor Create(Name: string);
    destructor Destroy; override;

    function get_Name: string; virtual;

    function  get_Enabled: boolean; virtual;
    procedure set_Enabled(value: boolean); virtual;

    function  Tests: ArrayList; virtual;

    function  CountTestCases: integer; virtual;
    function  CountEnabledTestCases: integer; virtual;

    function  Run: TTestResult; overload;
    procedure Run(testResult: TTestResult); overload;

    function  ElapsedTestTime: System.Int64; virtual;

    procedure SetStatusListener(Listener :IStatusListener);
    procedure Status(const Msg :string);
    function  get_Status :string;

    property Name:    string  read get_Name;
    property Enabled: boolean read get_Enabled write set_Enabled;


    procedure Check(condition: boolean; msg: string = ''); virtual;
    procedure CheckTrue(condition: boolean; msg: string = ''); virtual;
    procedure CheckFalse(condition: boolean; msg: string = ''); virtual;
    procedure CheckEquals(expected, actual: System.Double; msg: string = ''); overload; virtual;
    procedure CheckEquals(expected, actual: System.Double; delta: System.Double; msg: string = ''); overload; virtual;
    procedure CheckEquals(expected, actual: integer; msg: string = ''); overload; virtual;
    procedure CheckEquals(expected, actual: string; msg: string = ''); overload; virtual;
    procedure CheckEqualsString(expected, actual: string; msg: string = ''); virtual;
    procedure CheckEquals(expected, actual: boolean; msg: string = ''); overload; virtual;
    procedure CheckEqualsBin(expected, actual: longword; msg: string = ''; digits: integer=32); virtual;

    procedure CheckNotEquals(expected, actual: integer; msg: string = ''); overload; virtual;
    procedure CheckNotEquals(expected: System.Double; actual: System.Double; delta: System.Double = 0; msg: string = ''); overload; virtual;
    procedure CheckNotEquals(expected, actual: string; msg: string = ''); overload; virtual;
    procedure CheckNotEqualsString(expected, actual: string; msg: string = ''); virtual;
    procedure CheckNotEquals(expected, actual: boolean; msg: string = ''); overload; virtual;
    procedure CheckNotEqualsBin(expected, actual: longword; msg: string = ''; digits: integer=32); virtual;

    procedure CheckNotNull(obj :IUnknown; msg :string = ''); overload; virtual;
    procedure CheckNull(obj: IUnknown; msg: string = ''); overload; virtual;
    procedure CheckSame(expected, actual: System.String; msg: string = ''); overload; virtual;
    procedure CheckSame(expected, actual: System.Object; msg: string = ''); overload; virtual;

    procedure CheckNotNull(obj: TObject; msg: string = ''); overload; virtual;
    procedure CheckNull(obj: TObject; msg: string = ''); overload; virtual;

    procedure CheckException(AMethod: TTestMethod; AExceptionClass: TClass; msg :string = '');
    procedure CheckEquals(  expected, actual: TClass; msg: string = ''); overload; virtual;
    procedure CheckInherits(expected, actual: TClass; msg: string = ''); overload; virtual;
    procedure CheckIs(AObject :TObject; AClass: TClass; msg: string = ''); overload; virtual;

    procedure Fail(msg: sTring); overload; virtual;
    procedure FailEquals(expected, actual: WideString; msg: string = ''); virtual;
    procedure FailNotEquals(expected, actual: WideString; msg: string = ''); virtual;
    procedure FailNotSame(expected, actual: WideString; msg: string = ''); virtual;

    function EqualsErrorMessage(expected, actual :WideString; msg: string): WideString;
    function NotEqualsErrorMessage(expected, actual :WideString; msg: string): WideString;
    function NotSameErrorMessage(expected, actual, msg: string): WideString;

    procedure StopTests(msg: string = ''); virtual;

    procedure StartExpectingException(e: ExceptionClass);
    procedure StopExpectingException(msg :string = '');

    property ExpectedException :ExceptionClass
      read  fExpectedException
      write StartExpectingException;
  end;


  TTestCase = class(TAbstractTest, ITest)
  protected
    fMethod:    TTestMethod;

    procedure Invoke(AMethod: TTestMethod); override;
    procedure RunWithFixture(testResult: TTestResult); override;
    procedure RunTest(testResult: TTestResult); override;

  public
    constructor Create(MethodName: string); virtual;

    class function Suite: ITestSuite; virtual;

    procedure Run(testResult: TTestResult); overload;
  published
  end;


  TTestSuite = class(TAbstractTest, ITestSuite, ITest)
  protected
    fTests: ArrayList;
    procedure RunTest(testResult: TTestResult); override;
  public
    constructor Create; overload;
    constructor Create(Name: string); overload;
    constructor Create(TestClass: TTestCaseClass); overload;
    constructor Create(Name: string; const Tests: array of ITest); overload;

    function CountTestCases: integer;         override;
    function CountEnabledTestCases: integer;  override;

    function Tests: ArrayList;                 override;
    procedure AddTest(ATest: ITest);                virtual;
    procedure AddTests(testClass: TTestCaseClass);  virtual;
    procedure AddSuite(suite:  ITestSuite);         virtual;


  end;


  TTestFailure = class(TObject)
  protected
    fFailedTest: ITest;
    fThrownExceptionClass: TClass;
    fThrownExceptionMessage: string;
    FStackTrace:             string;

  public
    constructor Create(failedTest: ITest; thrownException: Exception; msg: string = '');

    function FailedTest: ITest; virtual;
    function ThrownExceptionClass: TClass; virtual;
    function ThrownExceptionName: string; virtual;
    function ThrownExceptionMessage: string; virtual;

    function StackTrace:   string; virtual;
  end;


  TMethodEnumerator = class
  protected
    FMethodNameList:  array of string;
    function GetNameOfMethod(Index: integer):  string;
    function GetMethodCount: Integer;
  public
    constructor Create(AClass: TClass);
    property MethodCount: integer read GetMethodCount;
    property NameOfMethod[index:  integer]: string read GetNameOfMethod;
  end;


// creating suites
function  TestSuite(name: string; const Tests: array of ITest): ITestSuite;

// test registry
procedure RegisterTest(SuitePath: string; test: ITest); overload;
procedure RegisterTest(test: ITest);                    overload;
procedure RegisterTests(SuitePath: string; const Tests: array of ITest);  overload;
procedure RegisterTests(const Tests: array of ITest);                     overload;
function  RegisteredTests: ITestSuite;
procedure ClearRegistry;

// running tests
function RunTest(suite: ITest; listeners: array of ITestListener): TTestResult; overload;
function RunRegisteredTests(listeners: array of ITestListener): TTestResult;


// utility routines
function IsTestMethod(aTest: ITest): Boolean;
function IsDecorator(aTest: ITest): Boolean;

//  strings, used in TAbstractTestCase.EqualsErrorMessage etc.:
const sExpButWasFmt    = '%sexpected: <%s> but was: <%s>';
      sExpAndActualFmt = '%sexpected and actual were: <%s>';


///////////////////////////////////////////////////////////////////////////
implementation

{$STACKFRAMES ON} //required to retreive caller's address

function IsTestMethod(aTest: ITest): Boolean;
var
  aTestSuite: ITestSuite;
  aTestDecorator: ITestDecorator;
begin
  Assert(Assigned(aTest));

  // Initialize to be sure
  aTestSuite := nil;
  aTestDecorator := nil;

  { The test should be a normal testmethod
    when the testcount = 1 }
  Result := (aTest.CountTestCases = 1);
(* ???
  // But not when the test is a suite? (It could have one test.)
{$IFDEF CLR}
  if Supports(aTest, ITestSuite) or Supports(aTest, ITestDecorator) then
    Result := false;
{$ELSE}
  aTest.QueryInterface(ITestSuite, aTestSuite);
  if Assigned(aTestSuite) then
    Result := false;

  // And not when the test is a decorator?
  aTest.QueryInterface(ITestDecorator, aTestDecorator);
  if Assigned(aTestDecorator) then
    Result := false;
{$ENDIF}
*)
end;

function IsDecorator(aTest: ITest): Boolean;
var
  aTestDecorator: ITestDecorator;
begin
  Assert(Assigned(aTest));

  // Initialize to be sure
  aTestDecorator := nil;
  Result := false;
(* ???
{$IFDEF CLR}
  Result := Supports(aTest, ItestDecorator);
{$ELSE}
  aTest.QueryInterface(ITestDecorator, aTestDecorator);
  Result := Assigned(aTestDecorator);
{$ENDIF}
*)
end;

{ TTestResult }

constructor TTestResult.Create;
begin
  inherited Create;
  fFailures := ArrayList.Create;
  fErrors := ArrayList.Create;
  fListeners := ArrayList.Create;
  fRunTests := 0;
  fStop := false;

  FStatusAdapter := TStatusToResultAdapter.Create(Self);
end;

destructor TTestResult.destroy;
var
  i: Integer;
begin
  fListeners := nil;
  for i := 0 to fErrors.Count - 1 do
  begin
    TTestFailure(fErrors[i]).Free;
  end;
  fErrors.Free;
  for i := 0 to fFailures.Count - 1 do
  begin
    TTestFailure(fFailures[i]).Free;
  end;
  fFailures.Free;
  inherited Destroy;
end;

procedure TTestResult.AddSuccess(test: ITest);
var
  i: integer;
begin
  assert(assigned(test));
  for i := 0 to fListeners.count - 1 do
  begin
    (fListeners[i] as ITestListener).AddSuccess(test);
  end;
end;

function TTestResult.AddError(test: ITest; e: Exception; msg: string): TTestFailure;
var
  i: integer;
  error:  TTestFailure;
begin
  assert(assigned(test));
  assert(assigned(e));
  assert(assigned(fErrors));

  error := TTestFailure.Create(test, e, msg);
  fErrors.add(error);
  for i := 0 to fListeners.count - 1 do
  begin
    (fListeners[i] as ITestListener).AddError(error);
  end;

  assert(assigned(error));
  Result := error;
end;

function TTestResult.AddFailure(test: ITest; e: Exception): TTestFailure;
var
  i: integer;
  Failure:  TTestFailure;
begin
  assert(assigned(test));
  assert(assigned(e));
  assert(assigned(fFailures));

  Failure := TTestFailure.Create(test, e);
  fFailures.add(Failure);
  for i := 0 to fListeners.count - 1 do
  begin
    (fListeners[i] as ITestListener).AddFailure(Failure);
  end;

  assert(assigned(Failure));
  Result := Failure;
end;

procedure TTestResult.addListener(listener: ITestListener);
begin
  assert(assigned(listener), 'listener is nil');
  fListeners.add(listener);
end;

procedure TTestResult.EndTest(test: ITest);
var
  i: integer;
begin
  assert(assigned(fListeners));

  try
    for i := 0 to fListeners.count - 1 do
    begin
      (fListeners[i] as ITestListener).EndTest(test);
    end;
  finally
    test.SetStatusListener(nil);
  end;
end;

procedure TTestResult.Status(test: ITest; const Msg: string);
var
  i: integer;
begin
  assert(assigned(fListeners));

  for i := 0 to fListeners.count - 1 do
  begin
    (fListeners[i] as ITestListener).Status(test, Msg);
  end;
end;

procedure TTestResult.Warning(test: ITest; const Msg: string);
begin
  assert(assigned(fWarnings));
  fWarnings.Add(Msg);
end;

function TTestResult.GetError(Index :Integer): TTestFailure;
begin
  Result := TObject(FErrors[Index]) as TTestFailure;
end;

function TTestResult.GetFailure(Index :Integer): TTestFailure;
begin
  Result := TObject(FFailures[Index]) as TTestFailure;
end;

function TTestResult.GetWarning(Index: Integer): string;
begin
  Result := fWarnings[Index] as System.String;
end;

function TTestResult.RunTestSetup(test: ITest):boolean;
begin
  try
    test.StopTime  := System.DateTime.Now;
    test.StartTime := System.DateTime.Now;
    test.SetUp;
    Result := true;
  except
    on e: Exception do
    begin
      AddError(test, e, 'SetUp FAILED: ');
      Result := false;
    end
  end;
end;

procedure TTestResult.RunTestTearDown(test: ITest);
begin
  try
    test.TearDown;
  except
    on e: Exception do
      AddError(test, e, 'TearDown FAILED: ');
  end;
  test.StopTime := System.DateTime.Now;
end;

function TTestResult.RunTestRun(test: ITest) : boolean;
var
  failure: TTestFailure;
begin
  Result := false;
  failure := nil;
  {$IFDEF USE_JEDI_JCL}
  try
    JclStartExceptionTracking;
  {$ENDIF}
    try
      test.RunTest(self);
      fTotalTime := FRootTest.ElapsedTestTime;
      AddSuccess(test);
      Result := true;
    except
      on e: EStopTestsFailure do
      begin
        failure := AddFailure(test, e);
        FStop := True;
      end;
      on e: ETestFailure do
      begin
        failure := AddFailure(test, e);
      end;
      on e: EBreakingTestFailure do
      begin
        failure := AddFailure(test, e);
      end;
      on e: Exception do
      begin
        failure := AddError(test, e);
      end;
    end;
  {$IFDEF USE_JEDI_JCL}
  finally
    JclStopExceptionTracking;
  end;
  {$ENDIF}
  if BreakOnFailures
  and (failure <> nil)
  and (failure.FThrownExceptionClass.InheritsFrom(ETestFailure))
  then
  begin
    try
       raise EBreakingTestFailure.Create(failure.ThrownExceptionMessage)
          {$IFNDEF CLR}at failure.ThrownExceptionAddress{$ENDIF};
    except
    end;
  end;
end;

procedure TTestResult.Run(test: ITest);
begin
  assert(assigned(test));
  if not ShouldStop and ShouldRunTest(test) then
  begin
    StartTest(test);
    try
      if RunTestSetUp(test) then
      begin
        RunTestRun(test);
      end;
      RunTestTearDown(test);
    finally
      EndTest(test);
    end;
  end;
end;

function TTestResult.RunCount: System.Int16;
begin
  result := fRunTests;
end;

function TTestResult.ShouldStop: boolean;
begin
  result := fStop;
end;

procedure TTestResult.StartTest(test: ITest);
var
  i: integer;
begin
  assert(assigned(test));
  assert(assigned(fListeners));

  test.SetStatusListener(FStatusAdapter);

  for i := 0 to fListeners.count - 1 do
  begin
    (fListeners[i] as ITestListener).StartTest(test);
  end;
end;

procedure TTestResult.Stop;
begin
  fStop := true;
end;

function TTestResult.ErrorCount: System.Int16;
begin
  assert(assigned(fErrors));

  result := fErrors.count;
end;

function TTestResult.FailureCount: System.Int16;
begin
  assert(assigned(fFailures));

  result := fFailures.count;
end;

function TTestResult.WarningCount: System.Int16;
begin
  assert(assigned(fWarnings));

  result := fWarnings.count;
end;

function TTestResult.WasSuccessful: boolean;
begin
  result := (FailureCount = 0) and (ErrorCount() = 0) and not WasStopped;
end;

procedure TTestResult.TestingStarts;
var
  i: Integer;
begin
  for i := 0 to fListeners.count - 1 do
  begin
    (fListeners[i] as ITestListener).TestingStarts;
  end;
end;

procedure TTestResult.TestingEnds;
var
  i: Integer;
begin
  for i := 0 to fListeners.count - 1 do
  begin
    (fListeners[i] as ITestListener).TestingEnds(self);
  end;
end;

function TTestResult.ShouldRunTest(test: ITest): boolean;
var
  i: Integer;
begin
  Result := True;
  for i := 0 to fListeners.count - 1 do
  begin
    if not (fListeners[i] as ITestListener).ShouldRunTest(test) then
    begin
      Result := false;
      break;
    end;
  end;
end;


function TTestResult.WasStopped: boolean;
begin
  result := fStop;
end;

procedure TTestResult.RunSuite(test: ITest);
begin
  TestingStarts;
  try
    FRootTest := test;
    test.RunWithFixture(self);
  finally
    TestingEnds
  end
end;

procedure TTestResult.EndSuite(suite: ITest);
var
  i: Integer;
  l: ITestListenerX;
begin
  for i := 0 to fListeners.count - 1 do
  begin
  	l := (fListeners[i] as ITestListenerX);
(* ???
{$IFDEF CLR}
    if Supports(fListeners[i], ITestListenerX, l) then
{$ELSE}
    if fListeners[i].QueryInterface(ITestListenerX, l) = 0 then
{$ENDIF}
*)
       l.EndSuite(suite);
  end;
end;

procedure TTestResult.StartSuite(suite: ITest);
var
  i: Integer;
  l: ITestListenerX;
begin
  for i := 0 to fListeners.count - 1 do
  begin
  	l := (fListeners[i] as ITestListenerX);
  
(* ???
{$IFDEF CLR}
    if Supports(fListeners[i], ITestListenerX, l) then
{$ELSE}
    if fListeners[i].QueryInterface(ITestListenerX, l) = 0 then
{$ENDIF}
*)
      l.StartSuite(suite);
  end;
end;

{ TStatusToResultAdapter }

constructor TStatusToResultAdapter.Create(TestResult: TTestResult);
begin
  Assert(TestResult <> nil, 'Expected non nil TestResult');
  inherited Create;

  FTestResult := TestResult;
end;

procedure TStatusToResultAdapter.Status(Test: ITest; const Msg: string);
begin
  FTestResult.Status(Test, Msg);
end;

procedure TStatusToResultAdapter.Warning(Test: ITest; const Msg: string);
begin
  FTestResult.Warning(Test, Msg);
end;

{ TAbstractTest }

constructor TAbstractTest.Create(Name: string);
begin
  inherited Create;
  FTestName := Name;
  FEnabled  := true;
end;

destructor TAbstractTest.Destroy;
begin
  FStatusStrings.Free;
  inherited;
end;

procedure TAbstractTest.Invoke(AMethod: TTestMethod);
begin
end;

procedure TAbstractTest.Run(testResult: TTestResult);
begin
  testResult.RunSuite(self);
end;

function TAbstractTest.CountEnabledTestCases: integer;
begin
  if get_Enabled then
    Result := 1
  else
    Result := 0
end;

function TAbstractTest.CountTestCases: integer;
begin
  Result := 1;
end;

function TAbstractTest.get_Enabled: boolean;
begin
  Result := fEnabled
end;

function TAbstractTest.get_Name: string;
begin
  Result := fTestName
end;

function TAbstractTest.Run: TTestResult;
var
  testResult:  TTestResult;
begin
  testResult := TTestResult.Create;
  try
    testResult.RunSuite(self);
  except
    testResult.Free;
    raise;
  end;
  Result := testResult;
end;

procedure TAbstractTest.set_Enabled(value: boolean);
begin
  fEnabled := value;
end;

var
  EmptyTestList: ArrayList = nil;

function TAbstractTest.Tests: ArrayList;
begin
   if EmptyTestList = nil then
     EmptyTestList := ArrayList.Create;
   Result := EmptyTestList;
end;


function TAbstractTest.get_StartTime: System.DateTime;
begin
  Result := FStartTime
end;

procedure TAbstractTest.set_StartTime(Value: System.DateTime);
begin
  FStartTime := Value;
end;

procedure TAbstractTest.set_StopTime(Value: System.DateTime);
begin
  FStopTime := Value;
end;

function TAbstractTest.get_StopTime: System.DateTime;
begin
  Result := FStopTime;
end;

procedure TAbstractTest.SetUp;
begin
 // do nothing
end;

procedure TAbstractTest.TearDown;
begin
  // do nothing
end;

procedure TAbstractTest.RunTest(testResult: TTestResult);
begin
  // do nothing
end;

function TAbstractTest.ElapsedTestTime: Int64;
var 
	Time: System.DateTime;
begin
  // returns TestTime in millisecs
  if fStopTime = fStartTime then
    Time := System.DateTime.Now
  else
    Time := fStopTime;

  result := Convert.ToInt64((Time - fStartTime).TotalMilliseconds);
end;


procedure TAbstractTest.SetStatusListener(Listener: IStatusListener);
begin
  FStatusListener := Listener;
end;

function TAbstractTest.get_Status: string;
begin
  if FStatusStrings = nil then
    Result := ''
  else
    Result := FStatusStrings[0] as System.String; (* ??? *)
end;

procedure TAbstractTest.Status(const Msg: string);
begin
  if FStatusStrings = nil then
    FStatusStrings := ArrayList.Create;
  FStatusStrings.Add(Msg);
  if FStatusListener <> nil then
    FStatusListener.Status(self, Msg);
end;

procedure TAbstractTest.RunWithFixture(testResult: TTestResult);
begin
  assert(assigned(testResult));
  if testResult.ShouldRunTest(self) then
    testResult.Run(self);
end;

procedure TAbstractTest.Check(condition: boolean; msg: string);
begin
    if (not condition) then
        Fail(msg);
end;

procedure TAbstractTest.CheckTrue(condition: boolean; msg: string);
begin
  if (not condition) then
      FailNotEquals(true.ToString(), false.ToString(), msg);
end;

procedure TAbstractTest.CheckFalse(condition: boolean; msg: string);
begin
  if (condition) then
      FailNotEquals(false.ToString(), true.ToString(), msg);
end;


procedure TAbstractTest.Fail(msg: string);
begin
  raise ETestFailure.Create(msg);
end;

procedure TAbstractTest.StopTests(msg: string);
begin
  raise EStopTestsFailure.Create(msg);
end;

procedure TAbstractTest.FailNotEquals( expected,
                                       actual   : WideString;
                                       msg      : string = '');
begin
    Fail(notEqualsErrorMessage(expected, actual, msg));
end;

procedure TAbstractTest.FailEquals(       expected,
                                          actual   : WideString;
                                          msg      : string = '');
begin
    Fail(EqualsErrorMessage(expected, actual, msg));
end;

procedure TAbstractTest.FailNotSame( expected,
                                     actual   : WideString;
                                     msg      : string = '');
begin
    Fail(NotSameErrorMessage(expected, actual, msg));
end;

procedure TAbstractTest.CheckEquals( expected,
                                 actual   : System.Double;
                                 delta    : System.Double;
                                 msg      : string = '');
begin
    if (Math.Abs(expected-actual) > delta) then
        FailNotEquals(expected.ToString(), actual.ToString(), msg);
end;

procedure TAbstractTest.CheckEquals(expected, actual: System.Double; msg: string);
begin
  CheckEquals(expected, actual, 0, msg);
end;

procedure TAbstractTest.CheckNotNull(obj: IUnknown; msg: string);
begin
    if obj = nil then
      Fail(msg);
end;

procedure TAbstractTest.CheckNull(obj: IUnknown; msg: string);
begin
    if obj <>  nil then
      Fail(msg);
end;

procedure TAbstractTest.CheckSame(expected, actual: System.String; msg: string = '');
begin
    if (expected <> actual) then
      FailNotSame(expected, actual, msg);
end;

procedure TAbstractTest.CheckEquals(expected, actual: string; msg: string = '');
begin
  if expected <> actual then
    FailNotEquals(expected, actual, msg);
end;

procedure TAbstractTest.CheckEqualsString(expected, actual: string; msg: string = '');
begin
  if expected <> actual then
    FailNotEquals(expected, actual, msg);
end;

procedure TAbstractTest.CheckNotEquals(expected, actual: string; msg: string = '');
begin
  if expected = actual then
    FailEquals(expected, actual, msg);
end;

procedure TAbstractTest.CheckNotEqualsString(expected, actual: string; msg: string = '');
begin
  if expected = actual then
    FailEquals(expected, actual, msg);
end;

procedure TAbstractTest.CheckEquals(expected, actual: integer; msg: string);
begin
  if (expected <> actual) then
    FailNotEquals(expected.ToString(), actual.ToString(), msg);
end;

procedure TAbstractTest.CheckNotEquals(expected, actual: integer; msg: string = '');
begin
  if expected = actual then
    FailEquals(expected.ToString(), actual.ToString(), msg);
end;

procedure TAbstractTest.CheckNotEquals(expected: System.Double; actual: System.Double; delta: System.Double = 0; msg: string = '');
begin
    if (abs(expected-actual) <= delta) then
        FailNotEquals(expected.ToString(), actual.ToString(), msg);
end;

procedure TAbstractTest.CheckEquals(expected, actual: boolean; msg: string);
begin
  if (expected <> actual) then
    FailNotEquals(expected.ToString(), actual.ToString(), msg);
end;

procedure TAbstractTest.CheckNotEquals(expected, actual: boolean; msg: string);
begin
  if (expected = actual) then
    FailEquals(expected.ToString(), actual.ToString(), msg);
end;

{ [KGS] IntToBin: Elected not to add to TestFrameWork interface,
        many people already have a self made version: }
function IntToBin(const value, digits: longword): string;
const 
  ALL_32_BIT_0 = '00000000000000000000000000000000';
var
  counter: integer;
  pow:     integer;
begin
  Result := ALL_32_BIT_0;
  SetLength(Result, digits);
  pow := 1 shl (digits - 1);
  if value <> 0 then
  for counter := 0 to digits - 1 do
  begin
    if (value and (pow shr counter)) <> 0 then
      Result[counter+1] := '1';
  end;
end;

procedure TAbstractTest.CheckEqualsBin(expected, actual: longword;
                                       msg: string = ''; digits: integer=32);
begin
  if expected <> actual then
    FailNotEquals(IntToBin(expected, digits), IntToBin(actual, digits), msg);
end;

procedure TAbstractTest.CheckNotEqualsBin(expected, actual: longword;
                                       msg: string = ''; digits: integer=32);
begin
  if (expected = actual) then
    FailEquals(IntToBin(expected, digits), IntToBin(actual, digits), msg);
end;

procedure TAbstractTest.CheckSame(expected, actual: System.Object; msg: string);
begin
    if (expected <> actual) then
      FailNotSame(expected.ToString(), actual.ToString(), msg);
end;

procedure TAbstractTest.CheckNotNull(obj: TObject; msg: string);
begin
    if obj = nil then
       FailNotSame(obj.ToString(), '', msg);
end;

procedure TAbstractTest.CheckNull(obj: TObject; msg: string);
begin
    if obj <> nil then
       FailNotSame('', obj.ToString(), msg);
end;

function TAbstractTest.NotEqualsErrorMessage(expected, actual: WideString; msg: string): WideString;
begin
    if (msg <> '') then
        msg := msg + ', ';
    Result := System.String.Format(sExpButWasFmt, msg, expected, actual);
end;

function TAbstractTest.EqualsErrorMessage(expected, actual: WideString; msg: string): WideString;
begin
    if (msg <> '') then
        msg := msg + ', ';
    Result := System.String.Format(sExpAndActualFmt, msg, expected)
end;

function TAbstractTest.NotSameErrorMessage(expected, actual, msg: string): WideString;
begin
    if (msg <> '') then
        msg := msg + ', ';
    Result := System.String.Format(sExpButWasFmt, msg, expected, actual)
end;

procedure TAbstractTest.StartExpectingException(e: ExceptionClass);
begin
  StopExpectingException;
  fExpectedException := e;
end;

procedure TAbstractTest.StopExpectingException(msg :string);
begin
  try
    if fExpectedException <> nil then
    begin
      Fail( System.String.Format( 'Expected exception "%s" but there was none. %s',
                                        fExpectedException.ClassName,
                                        Msg));
    end;
  finally
    fExpectedException := nil;
  end;
end;

{$IFNDEF CLR}
procedure TAbstractTest.CheckMethodIsNotEmpty(MethodPointer: pointer);
const
  AssemblerRet = $C3;
begin
  if byte(MethodPointer^) = AssemblerRet then
    fail('Empty test', MethodPointer);
end;
{$ENDIF}

procedure TAbstractTest.CheckException(AMethod: TTestMethod; AExceptionClass: TClass; msg :string);
begin
  try
    Invoke(AMethod);
  except
    on e :Exception do
    begin
      if  not Assigned(AExceptionClass) then
        raise
      else if not e.ClassType.InheritsFrom(AExceptionClass) then
        FailNotEquals(AExceptionClass.ClassName, e.ClassName, msg)
      else
        AExceptionClass := nil;
    end;
  end;
  if Assigned(AExceptionClass) then
    FailNotEquals(AExceptionClass.ClassName, 'nothing', msg)
end;

procedure TAbstractTest.CheckEquals(expected, actual: TClass; msg: string);
begin
 if expected <> actual then
 begin
   if expected = nil then
     FailNotEquals('nil', actual.ClassName, msg)
   else if actual = nil then
     FailNotEquals(expected.ClassName, 'nil', msg)
   else
     FailNotEquals(expected.ClassName, actual.ClassName, msg)
 end;
end;

procedure TAbstractTest.CheckInherits(expected, actual: TClass; msg: string);
begin
 if expected = nil then
   FailNotEquals('nil', actual.ClassName, msg)
 else if actual = nil then
   FailNotEquals(expected.ClassName, 'nil', msg)
 else if not actual.InheritsFrom(expected) then
   FailNotEquals(expected.ClassName, actual.ClassName, msg)
end;

procedure TAbstractTest.CheckIs(AObject: TObject; AClass: TClass; msg: string);
begin
 Assert(AClass <> nil);
 if AObject = nil then
   FailNotEquals(AClass.ClassName, 'nil', msg)
 else if not AObject.ClassType.InheritsFrom(AClass) then
   FailNotEquals(AClass.ClassName, AObject.ClassName, msg)
end;

function TAbstractTest.get_GUIObject: TObject;
begin
  Result := FGUIObject;
end;

procedure TAbstractTest.set_GUIObject(const guiObject: TObject);
begin
  FGUIObject := guiObject;
end;

{ TTestCase }

constructor TTestCase.Create(MethodName: string);
{$IFNDEF CLR}
var
  RunMethod: TMethod;
{$ENDIF}
begin
  assert(length(MethodName) >0);
{$IFNDEF CLR}
  assert(assigned(MethodAddress(MethodName)));
{$ELSE}
  assert(MethodName <> '');
{$ENDIF}

  inherited Create(MethodName);
{$IFDEF CLR}
  FMethod := MethodName;
{$ELSE}
  RunMethod.code := MethodAddress(MethodName);
  RunMethod.Data := self;
  fMethod := TTestMethod(RunMethod);

  assert(assigned(fMethod));
{$ENDIF}
end;

procedure TTestCase.Invoke(AMethod: TTestMethod);
{$IFDEF CLR}
var
  TestType: System.type;
  Args: array of System.Object;
  Flags: BindingFlags;
{$ENDIF}
begin
{$IFDEF CLR}
  try
    GetType.InvokeMember(AMethod, BindingFlags.Public or BindingFlags.Instance or BindingFlags.InvokeMethod, nil, Self, Args);
  except
    on E:TargetInvocationException do
      raise E.InnerException;
  end;
{$ELSE}
  AMethod;
{$ENDIF}
end;

procedure TTestCase.RunWithFixture(testResult: TTestResult);
begin
  assert(assigned(testResult));
  if testResult.ShouldRunTest(self) then
  begin
    inc(testResult.fRunTests);
    inherited;
  end;
end;

procedure TTestCase.RunTest(testResult: TTestResult);
begin
  assert(assigned(fMethod), 'Method "' + FTestName + '" not found');
  fExpectedException := nil;
  try
    try
{$IFNDEF CLR}
      CheckMethodIsNotEmpty(tMethod(fMethod).Code);
{$ENDIF}
      Invoke(fMethod);
      StopExpectingException;
    except
      on E: ETestFailure  do
      begin
        raise;
      end;
      on E: Exception  do
      begin
        if  not Assigned(fExpectedException) then
          raise
        else if not E.ClassType.InheritsFrom(fExpectedException) then
           FailNotEquals(fExpectedException.ClassName, E.ClassName, 'unexpected exception');
      end
    end;
  finally
    fExpectedException := nil;
  end;
end;

procedure TTestCase.Run(testResult: TTestResult);
begin
  testResult.RunSuite(self);
end;

class function TTestCase.Suite: ITestSuite;
begin
  Result := TTestSuite.Create(self);
end;

{ TTestFailure }

constructor TTestFailure.Create(FailedTest: ITest; thrownException: Exception; msg: string);
begin
  assert(assigned(thrownException));

  inherited Create;
  fFailedTest := FailedTest;
  fThrownExceptionClass := thrownException.ClassType;
  fThrownExceptionMessage := msg + thrownException.message;
  fStackTrace := thrownException.StackTrace;
end;

function TTestFailure.FailedTest: ITest;
begin
  result := fFailedTest;
end;

function TTestFailure.ThrownExceptionName: string;
begin
  result := fThrownExceptionClass.ClassName;
end;

function TTestFailure.ThrownExceptionMessage: string;
begin
  result := fThrownExceptionMessage;
end;

function TTestFailure.ThrownExceptionClass: TClass;
begin
  Result := FThrownExceptionClass;
end;

function TTestFailure.StackTrace: string;
begin
  Result := FStackTrace;
end;

{ TTestSuite }

constructor TTestSuite.Create;
begin
  Create(TObject.ClassName);
end;

constructor TTestSuite.Create(name: string);
begin
  assert(length(name) > 0);

  inherited Create(name);

  fTests := ArrayList.Create;
end;

constructor TTestSuite.Create( testClass: TTestCaseClass);
begin
  self.Create(testClass.ClassName);
  AddTests(testClass);
end;

constructor TTestSuite.Create(Name: string; const Tests: array of ITest);
var
  i: Integer;
begin
  self.Create(Name);
  for i := Low(Tests) to High(Tests) do begin
    Self.addTest(Tests[i])
  end;
end;

procedure TTestSuite.AddTest(ATest: ITest);
begin
  Assert(Assigned(ATest));

  fTests.Add(ATest);
end;

procedure TTestSuite.AddSuite(suite: ITestSuite);
begin
  AddTest(suite);
end;


procedure TTestSuite.AddTests(testClass: TTestCaseClass);
var
  MethodIter     :  Integer;
  NameOfMethod   :  string;
  MethodEnumerator:  TMethodEnumerator;
begin
  { call on the method enumerator to get the names of the test
    cases in the testClass }
  MethodEnumerator := nil;
  try
    MethodEnumerator := TMethodEnumerator.Create(testClass);
    { make sure we add each test case  to the list of tests }
    for MethodIter := 0 to MethodEnumerator.Methodcount-1 do
      begin
        NameOfMethod := MethodEnumerator.nameOfMethod[MethodIter];
        self.addTest(testClass.Create(NameOfMethod) as ITest);
      end;
  finally
    MethodEnumerator.free;
  end;
end;

function TTestSuite.CountTestCases: integer;
var
  test: ITest;
  i: Integer;
  Total:  integer;
begin
  assert(assigned(fTests));

  Total := 0;
  for i := 0 to fTests.Count - 1 do
  begin
    test := fTests[i] as ITest;
    Total := Total + test.CountTestCases;
  end;
  Result := Total;
end;

function TTestSuite.CountEnabledTestCases: integer;
var
  i: Integer;
  test: ITest;
  Total:  Integer;
begin
  assert(assigned(fTests));

  Total := 0;
  if get_Enabled then
  begin
    for i := 0 to fTests.Count - 1 do
    begin
      test := fTests[i] as ITest;
      Total := Total + test.CountEnabledTestCases;
    end;
  end;
  Result := Total;
end;

procedure TTestSuite.RunTest(testResult: TTestResult);
var
  i: Integer;
  test: ITest;
begin
  assert(assigned(testResult));
  assert(assigned(fTests));

  testResult.StartSuite(self);
  for i := 0 to fTests.Count - 1 do
  begin
    if testResult.ShouldStop then
      BREAK;
    test := fTests[i] as ITest;
    test.RunWithFixture(testResult);
  end;
  testResult.EndSuite(self);
end;

function TTestSuite.Tests: ArrayList;
begin
  result := fTests;
end;

{ ETestFailure }

constructor ETestFailure.Create;
begin
   inherited Create('')
end;

constructor ETestFailure.Create(msg: string);
begin
   inherited Create(msg)
end;

{ EBreakingTestFailure }

constructor EBreakingTestFailure.Create;
begin
   inherited Create('')
end;

constructor EBreakingTestFailure.Create(msg: string);
begin
   inherited Create(msg)
end;

{ TMethodEnumerator }

constructor TMethodEnumerator.Create(AClass: TClass);
{$IFDEF CLR}
var
  I, L: integer;
  T: System.Type;
  Methods: array of MethodInfo;

  function IsTest(AMethod: MethodInfo): boolean;
  var
    CustomAttr: array of System.Object;
    I: integer;
  begin
    Result := false;
    if AMethod.IsPublic then
    begin
      CustomAttr := AMethod.GetCustomAttributes(true);

      for I := 0 to System.Array(CustomAttr).Length - 1 do
      begin
        if CustomAttr[I].ClassNameIs('TestAttribute') then
        begin
          Result := true;
          Break;
        end;;
      end;
    end;
  end;
{$ELSE}
type
  TMethodTable = packed record
    count: SmallInt;
  //[...methods...]
  end;
var
  table: ^TMethodTable;
  name:  ^ShortString;
  i, j:  Integer;
{$ENDIF}
begin
  inherited Create;
{$IFDEF CLR}
  T := AClass.ClassInfo;
  Methods := T.GetMethods();
  L := 0;
  SetLength(FMethodNameList, L);
  for I := 0 to System.Array(Methods).Length - 1 do
    if IsTest(Methods[I]) then
    begin
      L := L + 1;
      SetLength(FMethodNameList, L);
      FMethodNameList[L-1] := Methods[I].Name;
    end;
{$ELSE}
  while aclass <> nil do
  begin
    // *** HACK ALERT *** !!!
    // Review System.MethodName to grok how this method works
    asm
      mov  EAX, [aclass]
      mov  EAX,[EAX].vmtMethodTable { fetch pointer to method table }
      mov  [table], EAX
    end;
    if table <> nil then
    begin
      name  := Pointer(PChar(table) + 8);
      for i := 1 to table.count do
      begin
        // check if we've seen the method name
        j := Low(FMethodNameList);
        while (j <= High(FMethodNameList))
        and (name^ <> FMethodNameList[j]) do
          inc(j);
        // if we've seen the name, then the method has probably been overridden
        if j > High(FMethodNameList) then
        begin
          SetLength(FMethodNameList,length(FMethodNameList)+1);
          FMethodNameList[j] := name^;
        end;
        name := Pointer(PChar(name) + length(name^) + 7)
      end;
    end;
    aclass := aclass.ClassParent;
  end;
{$ENDIF}
end;

function TMethodEnumerator.GetMethodCount: Integer;
begin
  Result := Length(FMethodNameList);
end;

function TMethodEnumerator.GetNameOfMethod(Index: integer): string;
begin
  Result := FMethodNameList[Index];
end;

{ Convenience routines }

function  TestSuite(name: string; const Tests: array of ITest): ITestSuite;
begin
   result := TTestSuite.Create(name, Tests);
end;

{ test registry }

var
  __TestRegistry: ITestSuite = nil;

procedure RegisterTestInSuite(rootSuite: ITestSuite; path: string; test: ITest);
var
  pathRemainder:  string;
  suiteName:  string;
  targetSuite:  ITestSuite;
  suite:  ITestSuite;
  currentTest:  ITest;
  Tests:  ArrayList;
  dotPos:  Integer;
  i: Integer;
begin
  if (path = '') then
  begin
    // End any recursion
    rootSuite.addTest(test);
  end
  else
  begin
    // Split the path on the dot (.)
    dotPos := Pos('.', Path);
    if (dotPos <= 0) then dotPos := Pos('\', Path);
    if (dotPos <= 0) then dotPos := Pos('/', Path);
    if (dotPos > 0) then
    begin
      suiteName := Copy(path, 1, dotPos - 1);
      pathRemainder := Copy(path, dotPos + 1, length(path) - dotPos);
    end
    else
    begin
      suiteName := path;
      pathRemainder := '';
    end;
    Tests := rootSuite.Tests;

    // Check to see if the path already exists
    targetSuite := nil;
    Tests := rootSuite.Tests;
    for i := 0 to Tests.count -1 do
    begin
      currentTest := Tests[i] as ITest;
(* ???      
{$IFDEF CLR}
      if Supports(currentTest, ITestSuite, suite) then
{$ELSE}
      currentTest.queryInterface(ITestSuite, suite);
      if Assigned(suite) then
{$ENDIF}
*)
      begin
        if (currentTest.get_Name = suiteName) then
        begin
          targetSuite := suite;
          break;
        end;
      end;
    end;

    if not assigned(targetSuite) then
    begin
      targetSuite := TTestSuite.Create(suiteName);
      rootSuite.addTest(targetSuite);
    end;

    RegisterTestInSuite(targetSuite, pathRemainder, test);
  end;
end;

procedure CreateRegistry;
var
  MyName :AnsiString;
begin
  MyName := paramstr(0);
  __TestRegistry := TTestSuite.Create(MyName);
end;

procedure RegisterTest(SuitePath: string; test: ITest);
begin
  assert(assigned(test));
  if __TestRegistry = nil then CreateRegistry;
  RegisterTestInSuite(__TestRegistry, SuitePath, test);
end;

procedure RegisterTest(test: ITest);
begin
  RegisterTest('', test);
end;

procedure RegisterTests(SuitePath: string; const Tests: array of ITest);
var
  i: Integer;
begin
  for i := Low(Tests) to High(Tests) do begin
    TestFramework.RegisterTest(SuitePath, Tests[i])
  end
end;

procedure RegisterTests(const Tests: array of ITest);
begin
  RegisterTests('', Tests);
end;

function RegisteredTests: ITestSuite;
begin
  result := __TestRegistry;
end;

function RunTest(suite: ITest; listeners: array of ITestListener): TTestResult; overload;
var
  i        : Integer;
begin
  result := TTestResult.Create;
  for i := low(listeners) to high(listeners) do
      result.addListener(listeners[i]);
  if suite <> nil then
    suite.Run(result);
end;

function RunRegisteredTests(listeners: array of ITestListener): TTestResult;
begin
  result := RunTest(RegisteredTests, listeners);
end;

procedure ClearRegistry;
begin
  __TestRegistry := nil;
end;

initialization
{$IFDEF LINUX}
  InitPerformanceCounter;
{$ENDIF}
finalization
  ClearRegistry;
end.