How to access fields of a TTestCase in a TTestSetup class

Question

I am creating unit tests with DUnit. I have a class that takes quite a long time to initialize.

I derive a class TMyTestSetup from TTestSetup and override its Setup method. This SetUp method is only called once for all the tests in my TTestCase. I put the Initialization process in the TMyTestSetup.SetUp routine to increase performance.

My problem is how can I access the object I want to initialize, which is a field of my TMyTest in the TestSetup class? Is the only way to do it declaring it globally?

untested short example:

TMyTestSetup = class(TTestSetup)
  protected
    procedure SetUp; override;
end;

TMyTest = class(TTestcase)
public
    fTakes4Ever2Init : TInits4Ever2Init;
published
  procedure Test1;     
end;

implementation

procedure TMyTestSetup.Setup;
begin
   // How can I access fTakes4Ever2Init from here?
  fTakes4Ever2Init.create // This is the call that takes long
end;

procedure TMyTest.Test1;
begin
  fTakes4Ever2Init.DoSomething;
end;

initialization
  RegisterTest(TMyTestSetup.Create(TMyTest.Suite));

Answer 1

The trick is to use a public class variable in the TMyTestSetup class.

Like this (tested and working, complete) example:

unit TestTestUnit;

interface

uses
  TestFramework, TestExtensions;

type
  TInits4Ever2Init = class
  private
    FValue: integer;
  public
    constructor Create;
    procedure   DoSomething1;
    procedure   DoSomething2;
    procedure   DoSomething3;
  end;

type
  TMyTestSetup = class(TTestSetup)
  public class var
    fTakes4Ever2Init: TInits4Ever2Init;
  protected
    procedure SetUp; override;
  end;

  TMyTest = class(TTestCase)
  published
    procedure Test1;
    procedure Test2;
    procedure Test3;
  end;

implementation

uses
  SysUtils, Windows;

{ TMyTestSetup }

procedure TMyTestSetup.Setup;
begin
  fTakes4Ever2Init := TInits4Ever2Init.create; // This is the call that takes long
end;

{ TMyTest }

procedure TMyTest.Test1;
begin
  TMyTestSetup.fTakes4Ever2Init.DoSomething1;
end;

procedure TMyTest.Test2;
begin
  TMyTestSetup.fTakes4Ever2Init.DoSomething2;
end;

procedure TMyTest.Test3;
begin
  TMyTestSetup.fTakes4Ever2Init.DoSomething3;
end;

{ TInits4Ever2Init }

constructor TInits4Ever2Init.Create;
begin
  inherited Create;

  // FValue and Format('%p, %d', [Pointer(Self), FValue])) are to confirm
  //   that we are talking to the same object for all the tests,
  //   but that the object is different each time we run the test suite.

  Randomize;
  FValue := Random(10000);

  OutputDebugString(pAnsiChar('-- TInits4Ever2Init.Create: '
    + Format('%p, %d', [Pointer(Self), FValue])));
end;

procedure TInits4Ever2Init.DoSomething1;
begin
  OutputDebugString(pAnsiChar('-- TInits4Ever2Init.DoSomething1: '
    + Format('%p, %d', [Pointer(Self), FValue])));
end;

procedure TInits4Ever2Init.DoSomething2;
begin
  OutputDebugString(pAnsiChar('-- TInits4Ever2Init.DoSomething2: '
    + Format('%p, %d', [Pointer(Self), FValue])));
end;

procedure TInits4Ever2Init.DoSomething3;
begin
  OutputDebugString(pAnsiChar('-- TInits4Ever2Init.DoSomething3: '
    + Format('%p, %d', [Pointer(Self), FValue])));
end;

initialization
  RegisterTest(TMyTestSetup.Create(TMyTest.Suite));
end.

As the comments in the sample indicate, I have used a randomised private variable, and some debug trace output, to confirm that each test call with the test suite is to the same copy of the target object, but that we are getting a different copy of the target object each time the test suite is run.

Answer 2

Depending on your Delphi version, you can simply make the TMyTest.fTakes4Ever2Init field a public class var to initialize it from the test setup. (This would be more OOP style compared to a unit-global variable.)

Answer 3

You can derive a new Test Suite class from TTestSuite class, and override its SetUp and TearDown methods, then you can add your test cases to this particular test suite, and register the suite.

This way, Setup and TearDown methods of your test suite class will be called once, and SetUp and TearDown methods of each test case will be called for every test method defined in that test case.

Execution order will be like this:

TestSuite.SetUp;

-- TestCase1.Setup;
---- TestCase1.Test1;
-- TestCase1.TearDown;
-- TestCase1.Setup;
---- TestCase1.Test2;
-- TestCase1.TearDown;

-- TestCase2.Setup;
---- TestCase2.Test1;
-- TestCase2.TearDown;
-- TestCase2.Setup;
---- TestCase2.Test2;
-- TestCase2.TearDown;

-- TestCaseN.Setup;
---- TestCaseN.Test1;
-- TestCaseN.TearDown;
-- TestCaseN.Setup;
---- TestCaseN.Test2;
-- TestCaseN.TearDown;

TestSuite.TearDown;

Answer 4

Using TTestSetup you could do something like this:

type
  TMyTestSetup = class(TTestSetup)
  private
    FValue: Integer;
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  end;

  TMyTestCase = class(TTestCase)
  published
    procedure TestSomething;
  end;

var
  TestSetup: TMyTestSetup;

procedure TMyTestSetup.SetUp;
begin
  inherited;
  TestSetup := Self;
  FValue := 42;
end;

procedure TMyTestSetup.TearDown;
begin
  TestSetup := nil;
  inherited;
end;

procedure TMyTestCase.TestSomething;
begin
  CheckEquals(TestSetup.FValue, 42);
end;

initialization
  TestFramework.RegisterTest(TMyTestSetup.Create(
    TTestSuite.Create('My test suite', [TMyTestCase.Suite])
  ));

It feels somewhat revolting mind you, but it does the job!

Answer 5

You can't initialize TTestCase fields for a whole test suite, and here is an explanation why:

unit Tests3;

interface

uses
  TestFramework, TestExtensions, Windows, Forms, Dialogs, Controls, Classes,
  SysUtils, Variants, Graphics, Messages;

type
  TMyTestCase = class(TTestCase)
  private
    FValue: Integer;
  published
    procedure Test1;
    procedure Test2;
  end;

implementation

{ TMyTestCase }

procedure TMyTestCase.Test1;
begin
  FValue:= 99;
  ShowMessage(Format('%p, %d', [Pointer(Self), FValue]));
end;

procedure TMyTestCase.Test2;
begin
  ShowMessage(Format('%p, %d', [Pointer(Self), FValue]));
end;

initialization
  RegisterTest(TMyTestCase.Suite);
end.

If you run the above unit test you will see that the 'Self' addresses shown in Test1 and Test2 methods are different. That means that TMyTestCase object instances are different for Test1 and Test2 calls.

Consequently, any fields you may declare in TMyTestCase class are volatile between test method's calls.

To perform "global" initialization you should declare your object globally, not as TMyTestCase field.

Answer 6

Having just one published method, which in turn call all your other test methods is the lazy but quicker way of having the Setup and TearDown procedure called only once.

Answer 7

The better solution (... IMHO)

It's a pretty old question, but I can imagine people still bumping into this. I did.

My initial solution to this problem also used class vars or globals. But indeed this solution is bad as it makes it very hard to re-use TTestSetup derived classes. Hence I debugged a bit to find how DUnit works internally. (I use DUnit extensively on my flagship app and libs)

As it turns out you actually can get access to the subtests: from within TTestSetup.RunTest. In this method you get a handle to the wrapped/decorated Subtest, which actually turned out to be a TTestSuite, created from my TTestCase.Suite. So I loop through the ITestsuite subtests (which are actually method calls for each published method in your TtestCase), and check if they support my ITestDecoratable interface, if so I call the SetupDecoration.

Next, the actual test is performed by calling the inherited Runtest.

And finally we go through the same loop again, this time calling TearDownDecoration.

This did not fix the nested TTestsetup case, so I added a check if TTestDecorator.Test supports ITestDecoratable directly, and execute accordingly. For that matter, I alsom implemented the ITestDecoratable in my TDecoratedTestSetup so nesting is also supported.

And came up with this solution. I even created a unit test for it, and everything works as intended.

I can imagine one would rather implement these methods in TTestCase and TTestDecorator directly, but for now I have put it in a separate unit. I'll add a ticket to the corresponding sourceforge site.

---

Here's my solution:

unit uDecoratorTestBase;

interface

uses TestFramework,TestExtensions;

type
/// <summary>
///   when a test implements the interface below, and the TDecoratedTestSetup
///  is used, these methods get called dureing testing.
/// </summary>
  ITestDecoratable=interface (ITest)
    ['{468A66E9-937B-4C45-9321-A1796F93470C}']
    /// <summary>
    ///   gets called before the Setup call
    /// </summary>
    procedure SetupDecoration(const aDecorator:ITestDecorator);
    /// <summary>
    ///   gets called after the teardown call
    /// </summary>
    procedure TeardownDecoration(const aDecorator:ITestDecorator);
  end;

  /// <summary>
  ///  an alternatine to TTestSetup this implementation tries to decorate
  ///  any subtests when it is executed through the ITestDecoratable interface
  ///  bonus feature is that iself also supports the ItestDecoratable interface
  ///  allowing for multiple layes of decoration
  /// </summary>
  TDecoratedTestSetup=class(TTestDecorator,ITestDecoratable)
  private
  protected
    procedure RunTest(ATestResult: TTestResult); override;
    procedure SetupDecoration(const aDecorator:ITestDecorator); virtual;
    procedure TeardownDecoration(const aDecorator:ITestDecorator); virtual;
  end;
  /// <summary>
  ///   Same as TTestcase, but adds the ITestDecoratable interface. Override
  ///  the routines below to get values from the decorator class through
  ///  the provided ITestDecorator interface.
  /// </summary>
  TDecoratedTestCase=class(TTestCase,ITestDecoratable)
  protected
    procedure SetupDecoration(const aDecorator:ITestDecorator); virtual;
    procedure TeardownDecoration(const aDecorator:ITestDecorator); virtual;
  end;

implementation

uses
  sysutils;

{ TDecoratedTestSetup }

procedure TDecoratedTestSetup.RunTest(ATestResult: TTestResult);
var lDecoratable:ITestDecoratable;
var lSuite:ITestSuite;
begin
  if Supports(Test,ITestDecoratable,lDecoratable) then
  try
    lDecoratable.SetupDecoration(self);
    inherited;
  finally
    lDecoratable.TeardownDecoration(self);
  end
  else if Supports(Test,ITestSuite,lSuite) then
  try
    for var I := 0 to lSuite.Tests.Count-1 do
      if Supports(lSuite.Tests[i],ITestDecoratable,lDecoratable) then
        lDecoratable.SetupDecoration(self);
    inherited;
  finally
    for var I := 0 to lSuite.Tests.Count-1 do
      if Supports(lSuite.Tests[i],ITestDecoratable,lDecoratable) then
        lDecoratable.TeardownDecoration(self);
  end
  else inherited;
end;

procedure TDecoratedTestSetup.SetupDecoration(const aDecorator: ITestDecorator);
begin
  // override to initialize class fields using the decorator
end;

procedure TDecoratedTestSetup.TeardownDecoration(const aDecorator: ITestDecorator);
begin
  // override to finalize class fields previously initialized through SetupDecoration
end;

{ TDecoratedTestCase }

procedure TDecoratedTestCase.SetupDecoration(const aDecorator: ITestDecorator);
begin
  // override to initialize class fields using the decorator
end;

procedure TDecoratedTestCase.TeardownDecoration(
  const aDecorator: ITestDecorator);
begin
  // override to finalize class fields previously initialized through SetupDecoration
end;

end.

---

Unit Test

And here's the unit test I created for my solution. Running this should shed some light and hopefully make you understand what's going on.

unit UnitTestDecorator;

interface

uses
  TestFrameWork,uDecoratorTestBase;

type
  /// <summary>
  ///   Perofms the actuel self-test by running decorated testcases
  /// </summary>
  TTestDecoratorTest=class(TTestCase)
  private
  protected
    procedure SetUp; override;
  published
    procedure TestDecorated;
  end;



implementation

type
  TMyDecoratedTestCase=class(TDecoratedTestCase)
  private
    class var FDecorateCalls:integer;
    class var FUndecorateCalls:integer;
  protected
    procedure SetupDecoration(const aDecorator:ITestDecorator); override;
    procedure TeardownDecoration(const aDecorator:ITestDecorator); override;
    procedure Setup; override;
    procedure TearDown; override;
  published
    procedure CheckSetupTearDown;
    procedure FailTest;
  end;

  TMyInnerDecoratedTestSetup=class(TDecoratedTestSetup)
  private
    class var FDecorateCalls:integer;
    class var FUndecorateCalls:integer;
  protected
    procedure SetupDecoration(const aDecorator:ITestDecorator); override;
    procedure TeardownDecoration(const aDecorator:ITestDecorator); override;
    procedure Setup; override;
    procedure TearDown; override;
  published
    procedure CheckSetupTearDown;
  end;

  TMyOuterDecoratedTestSetup=class(TDecoratedTestSetup)
  private
    class var FDecorateCalls:integer;
    class var FUndecorateCalls:integer;
  protected
    procedure SetupDecoration(const aDecorator:ITestDecorator); override;
    procedure TeardownDecoration(const aDecorator:ITestDecorator); override;
  published
    procedure CheckSetupTearDown;
  end;


{ TTestDecoratorTest }

procedure TTestDecoratorTest.Setup;
begin
  inherited;
  TMyDecoratedTestCase.FDecorateCalls:=0;
  TMyDecoratedTestCase.FUndecorateCalls:=0;
  TMyInnerDecoratedTestSetup.FDecorateCalls:=0;
  TMyInnerDecoratedTestSetup.FUndecorateCalls:=0;
  TMyOuterDecoratedTestSetup.FDecorateCalls:=0;
  TMyOuterDecoratedTestSetup.FUndecorateCalls:=0;
end;

procedure TTestDecoratorTest.TestDecorated;
begin
  var lTestCaseSuite:=TMyDecoratedTestCase.Suite;
  var lInnerTestSetup:=TMyInnerDecoratedTestSetup.Create(lTestCaseSuite) as ITest;
  var lOuterTestSetup:=TMyOuterDecoratedTestSetup.Create(lInnerTestSetup) as ITest;
  var lTestResult:=TTestResult.Create;
  try
    lOuterTestSetup.RunTest(lTestResult);
    CheckEquals(0,lTestResult.ErrorCOunt,'lTestResult.ErrorCOunt');
    CheckEquals(1,lTestResult.FailureCOunt,'lTestResult.FailureCOunt');
  finally
    lTestResult.Free;
  end;

  CheckEquals(2,TMyDecoratedTestCase.FDecorateCalls,'TMyDecoratedTestCase.FDecorateCalls');
  CheckEquals(TMyDecoratedTestCase.FDecorateCalls,TMyDecoratedTestCase.FUndecorateCalls,'TMyDecoratedTestCase.FUndecorateCalls');

  CheckEquals(1,TMyInnerDecoratedTestSetup.FDecorateCalls,'TMyInnerDecoratedTestSetup.FDecorateCalls');
  CheckEquals(TMyInnerDecoratedTestSetup.FDecorateCalls,TMyInnerDecoratedTestSetup.FUndecorateCalls,'TMyInnerDecoratedTestSetup.FUndecorateCalls');

  CheckEquals(0,TMyOuterDecoratedTestSetup.FDecorateCalls,'TMyOuterDecoratedTestSetup.FDecorateCalls');
  CheckEquals(TMyOuterDecoratedTestSetup.FDecorateCalls,TMyOuterDecoratedTestSetup.FUndecorateCalls,'TMyOuterDecoratedTestSetup.FUndecorateCalls');
end;

{ TMyDecoratedTestCase }

procedure TMyDecoratedTestCase.CheckSetupTearDown;
begin
  CheckNotEquals(0,FDecorateCalls,'FDecorateCalls');
  CheckEquals(0,FUnDecorateCalls,'FUnDecorateCalls');
end;

procedure TMyDecoratedTestCase.FailTest;
begin
  Fail('Intentionally');
end;

procedure TMyDecoratedTestCase.Setup;
begin
  inherited;
  CheckNotEquals(0,FDecorateCalls,'FDecorateCalls'); // decorate must take place BEFORE setup
end;

procedure TMyDecoratedTestCase.SetupDecoration(
  const aDecorator: ITestDecorator);
begin
  inherited;
  inc(FDecorateCalls);
end;

procedure TMyDecoratedTestCase.TearDown;
begin
  inherited;
  CheckEquals(0,FUnDecorateCalls,'FUnDecorateCalls'); // undecorate must take place AFTER Teardown
end;

procedure TMyDecoratedTestCase.TeardownDecoration(
  const aDecorator: ITestDecorator);
begin
  inherited;
  inc(FUnDecorateCalls);
end;

{ TMyInnerDecoratedTestSetup }

procedure TMyInnerDecoratedTestSetup.CheckSetupTearDown;
begin
  CheckNotEquals(0,FDecorateCalls,'FDecorateCalls');
  CheckEquals(0,FUnDecorateCalls,'FUnDecorateCalls');
end;

procedure TMyInnerDecoratedTestSetup.Setup;
begin
  inherited;
  CheckNotEquals(0,FDecorateCalls,'FDecorateCalls'); // decorate must take place BEFORE setup
end;

procedure TMyInnerDecoratedTestSetup.SetupDecoration(
  const aDecorator: ITestDecorator);
begin
  inc(FDecorateCalls);
  inherited;
end;

procedure TMyInnerDecoratedTestSetup.TearDown;
begin
  inherited;
  CheckEquals(0,FUnDecorateCalls,'FUnDecorateCalls'); // undecorate must take place AFTER Teardown
end;

procedure TMyInnerDecoratedTestSetup.TeardownDecoration(
  const aDecorator: ITestDecorator);
begin
  inherited;
  inc(FUnDecorateCalls);
end;

{ TMyOuterDecoratedTestSetup }

procedure TMyOuterDecoratedTestSetup.CheckSetupTearDown;
begin
  CheckEquals(0,FDecorateCalls);
  CheckEquals(0,FUnDecorateCalls);
end;

procedure TMyOuterDecoratedTestSetup.SetupDecoration(
  const aDecorator: ITestDecorator);
begin
  inherited;
  inc(FDecorateCalls);
end;

procedure TMyOuterDecoratedTestSetup.TeardownDecoration(
  const aDecorator: ITestDecorator);
begin
  inherited;
  inc(FUnDecorateCalls);
end;

initialization
  RegisterTests('Decorator Test setup extensions for DUnit',
                     [
                       TTestDecoratorTest.Suite
                     ]);

end.