delphi - 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));

score 8 · Accepted Answer

诀窍是在 TMyTestSetup 类中使用公共类变量。

像这样（经过测试和工作，完整）示例：

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.

正如示例中的注释所示，我使用了一个随机私有变量和一些调试跟踪输出，以确认使用测试套件的每个测试调用都是针对目标对象的同一副本，但我们得到的是不同的副本每次运行测试套件时的目标对象。

score 5 · Accepted Answer

您可以从 TTestSuite 类派生一个新的测试套件类，并覆盖其 SetUp 和 TearDown 方法，然后您可以将您的测试用例添加到这个特定的测试套件，并注册该套件。

这样，您的测试套件类的 Setup 和 TearDown 方法将被调用一次，并且每个测试用例的 SetUp 和 TearDown 方法将为该测试用例中定义的每个测试方法调用。

执行顺序将是这样的：

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;

score 3 · Accepted Answer

只有一个已发布的方法，然后调用所有其他测试方法，这是让 Setup 和 TearDown 过程只调用一次的懒惰但更快捷的方法。

score 2 · Accepted Answer

您不能为整个测试套件初始化 TTestCase 字段，这里解释一下原因：

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.

如果您运行上述单元测试，您将看到 Test1 和 Test2 方法中显示的“Self”地址不同。这意味着 TMyTestCase 对象实例对于 Test1 和 Test2 调用是不同的。

因此，您可以在 TMyTestCase 类中声明的任何字段在测试方法调用之间都是可变的。

要执行“全局”初始化，您应该全局声明您的对象，而不是 TMyTestCase 字段。

score 1 · Accepted Answer

根据您的 Delphi 版本，您可以简单地使TMyTest.fTakes4Ever2Init字段 apublic class var从测试设置中对其进行初始化。（与单元全局变量相比，这将是更多的 OOP 风格。）

score 1 · Accepted Answer

使用TTestSetup你可以做这样的事情：

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])
  ));

感觉有点令人反感，但它确实有效！

score 0 · Accepted Answer

更好的解决方案（...恕我直言）

这是一个相当古老的问题，但我可以想象人们仍然会遇到这个问题。我做到了。

我对这个问题的最初解决方案也使用了类变量或全局变量。但确实这种解决方案很糟糕，因为它使得重用TTestSetup派生类变得非常困难。因此，我进行了一些调试以了解 DUnit 内部的工作原理。（我在我的旗舰应用程序和库中广泛使用 DUnit）

事实证明，您实际上可以访问子测试：从TTestSetup.RunTest. 在这种方法中，您可以获得包装/装饰的 Subtest 的句柄，它实际上是TTestSuite从 my TTestCase.Suite. 所以我循环遍历ITestsuite子测试（实际上是你的每个已发布方法的方法调用TtestCase），并检查它们是否支持我的ITestDecoratable接口，如果支持，我调用SetupDecoration.

接下来，通过调用inherited Runtest.

最后我们再次经历同样的循环，这次调用TearDownDecoration.

这并没有修复嵌套的TTestsetup情况，所以我直接添加了一个检查是否TTestDecorator.Test支持ITestDecoratable，并相应地执行。就此而言，我也实现了ITestDecoratable我的TDecoratedTestSetup嵌套，因此也支持。

并想出了这个解决方案。我什至为它创建了一个单元测试，一切都按预期工作。

我可以想象有人宁愿直接实现这些方法TTestCase，TTestDecorator但现在我把它放在一个单独的单元中。我将向相应的sourceforge站点添加一张票。

这是我的解决方案：

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 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.

delphi - How to access fields of a TTestCase in a TTestSetup class

7 回答 7

Related

Reference