如何用DUnit模拟Spring4D事件

Question

我正在努力用DUnit成功模拟一个Spring4d事件。

事实上，我更嘲笑一个模拟一个事件的模拟......

这是基本结构。

TMyObject --EventContainer--> TMock<IEventContainer> --Event--> TMock<IEvent>

TMyObject有一个属性EventContainer：IEventContainer

IEventContainer有一个属性Event：IMyEvent

我想模仿

MyObject.EventContainer.Event.Add

我测试了我能想到的每种可能性。我得到AV或无效的演员。我把源代码放在下面。如果有人能帮助我完成这项工作真的很棒！

program Project2;

{$APPTYPE CONSOLE}
{$R *.res}

uses
    System.SysUtils,
    DUnitTestRunner,
    Spring.Events,
    Spring,
    Classes,
    TestFramework,
    Delphi.Mocks;
    //Unit1 in 'Unit1.pas';

type

{$M+}
    IMyEvent = interface(IEvent<TNotifyEvent>)
        procedure Add(const handler: TMethod);
    end;
{$M-}
{$M+}

    IMyEventMock = interface(IMyEvent)
        procedure Add(const handler: TMethod);
    end;
{$M-}
{$M+}

    IEventContainer = interface(IInterface)
        function GetEvent: IMyEvent;
        procedure SetEvent(const Value: IMyEvent);
        property Event: IMyEvent
            read GetEvent
            write SetEvent;
    end;
{$M-}
{$M+}

    ITestEventContainer = interface(IEventContainer)
        function GetEvent: TMock<IMyEvent>;
        procedure SetEvent(const Value: TMock<IMyEvent>);
        property Event: TMock<IMyEvent>
            read GetEvent
            write SetEvent;
    end;
{$M-}
{$REGION 'TEventContainer'}

    TEventContainer = class(TInterfacedObject, IEventContainer)

    private
        FAEvent: IMyEvent;
        function GetEvent: IMyEvent;
        procedure SetEvent(const Value: IMyEvent);

    public
        property Event: IMyEvent
            read GetEvent
            write SetEvent;
    end;

{$ENDREGION}
{$REGION 'TMyObject'}

    TMyObject = class(TObject)
    private
        FEventContainer: IEventContainer;
        function GetEventContainer: IEventContainer;
        procedure SetEventContainer(const Value: IEventContainer);

    public
        property EventContainer: IEventContainer
            read GetEventContainer
            write SetEventContainer;
    end;

{$ENDREGION}
{$REGION 'TMyObjectTest'}

    TMyObjectTest = class(TTestCase)
    strict private
        FMyObject: TMyObject;
        FMyEventContainerMock: TMock<IEventContainer>;
        FMyTestEventContainerMock: TMock<ITestEventContainer>;
        FEventMock: TMock<IMyEventMock>;

    public
        procedure SetUp; override;
        procedure TearDown; override;

    published
        procedure Test_InstanceAsValue;
        procedure Test_Value_Make;
        procedure Test_Value_From;
        procedure Test_Value_From_Instance;
        procedure Test_Value_From_Variant;
        procedure Test_Value_From_Variant_Instance;
        procedure Test_Mocked_Container_Value_Make;
        procedure Test_Mocked_Container_Value_From;
        procedure Test_Mocked_Container_Value_From_Instance;
        procedure Test_Mocked_Container_Value_From_Variant;
        procedure Test_Mocked_Container_Value_From_Variant_Instance;
    end;
{$ENDREGION}


{$REGION 'TEventContainer'}

function TEventContainer.GetEvent: IMyEvent;
begin
    Result := FAEvent;
end;

procedure TEventContainer.SetEvent(const Value: IMyEvent);
begin
    FAEvent := Value;
end;
{$ENDREGION}

{$REGION 'TMyObject'}

function TMyObject.GetEventContainer: IEventContainer;
begin
    Result := FEventContainer;
end;

procedure TMyObject.SetEventContainer(const Value: IEventContainer);
begin
    FEventContainer := Value;
end;
{$ENDREGION}

{$REGION 'TMyObjectTest'}

procedure TMyObjectTest.SetUp;
begin
    inherited;

    FMyObject := TMyObject.Create;

    FMyEventContainerMock := TMock<IEventContainer>.Create;

    FMyObject.EventContainer := FMyEventContainerMock;

end;

procedure TMyObjectTest.TearDown;
begin
    inherited;

    FMyObject.Free;

    FMyObject := nil;
end;

procedure TMyObjectTest.Test_Value_Make;
var aValue : TValue;
begin
    FEventMock := TMock<IMyEventMock>.Create;

    TValue.Make(@FEventMock, TypeInfo(IMyEventMock), aValue);

    FMyEventContainerMock.SetUp.WillReturnDefault('GetEvent', aValue);

    FMyObject.EventContainer.Event;
end;

procedure TMyObjectTest.Test_InstanceAsValue;
begin
    FEventMock := TMock<IMyEventMock>.Create;

    FMyEventContainerMock.SetUp.WillReturnDefault('GetEvent', FEventMock.InstanceAsValue);

    FMyObject.EventContainer.Event;
end;

procedure TMyObjectTest.Test_Mocked_Container_Value_From;
begin

    FMyTestEventContainerMock := TMock<ITestEventContainer>.Create;

    FMyObject.EventContainer := FMyTestEventContainerMock;

    FEventMock := TMock<IMyEventMock>.Create;

    FMyTestEventContainerMock.SetUp.WillReturnDefault('GetEvent', FEventMock.InstanceAsValue);

    FMyObject.EventContainer.Event;

end;

procedure TMyObjectTest.Test_Mocked_Container_Value_From_Instance;
begin
FMyTestEventContainerMock := TMock<ITestEventContainer>.Create;

    FMyObject.EventContainer := FMyTestEventContainerMock;

    FEventMock := TMock<IMyEventMock>.Create;

    FMyTestEventContainerMock.SetUp.WillReturnDefault('GetEvent', TValue.From(FEventMock));

    FMyObject.EventContainer.Event;
end;

procedure TMyObjectTest.Test_Mocked_Container_Value_From_Variant;
begin
    FMyTestEventContainerMock := TMock<ITestEventContainer>.Create;

    FMyObject.EventContainer := FMyTestEventContainerMock;

    FEventMock := TMock<IMyEventMock>.Create;

    FMyTestEventContainerMock.SetUp.WillReturnDefault('GetEvent', TValue.FromVariant(FEventMock));

    FMyObject.EventContainer.Event;
end;

procedure TMyObjectTest.Test_Mocked_Container_Value_From_Variant_Instance;
begin
    FMyTestEventContainerMock := TMock<ITestEventContainer>.Create;

    FMyObject.EventContainer := FMyTestEventContainerMock;

    FEventMock := TMock<IMyEventMock>.Create;

    FMyTestEventContainerMock.SetUp.WillReturnDefault('GetEvent', TValue.FromVariant(FEventMock.Instance));

    FMyObject.EventContainer.Event;
end;

procedure TMyObjectTest.Test_Mocked_Container_Value_Make;
var aValue : TValue;
begin
    FMyTestEventContainerMock := TMock<ITestEventContainer>.Create;

    FMyObject.EventContainer := FMyTestEventContainerMock;

    FEventMock := TMock<IMyEventMock>.Create;

    TValue.Make(@aValue, TypeInfo(TMock<IMyEventMock>), aValue);

    FMyTestEventContainerMock.SetUp.WillReturnDefault('GetEvent', aValue);

    FMyObject.EventContainer.Event;
end;

procedure TMyObjectTest.Test_Value_From;
begin
    FEventMock := TMock<IMyEventMock>.Create;

    FMyEventContainerMock.SetUp.WillReturnDefault('GetEvent', TValue.From(FEventMock));

    FMyObject.EventContainer.Event;
end;

procedure TMyObjectTest.Test_Value_From_Instance;
begin
    FEventMock := TMock<IMyEventMock>.Create;

    FMyEventContainerMock.SetUp.WillReturnDefault('GetEvent', TValue.From(FEventMock.Instance));

    FMyObject.EventContainer.Event;
end;

procedure TMyObjectTest.Test_Value_From_Variant;
begin
    FEventMock := TMock<IMyEventMock>.Create;

    FMyEventContainerMock.SetUp.WillReturnDefault('GetEvent', TValue.FromVariant(FEventMock));

    FMyObject.EventContainer.Event;
end;

procedure TMyObjectTest.Test_Value_From_Variant_Instance;
begin
    FEventMock := TMock<IMyEventMock>.Create;

    FMyEventContainerMock.SetUp.WillReturnDefault('GetEvent', TValue.FromVariant(FEventMock.Instance));

    FMyObject.EventContainer.Event;
end;

begin
    RegisterTest(TMyObjectTest.Suite);
    try
        DUnitTestRunner.RunRegisteredTests;
        ReadLn;
    except
        on E: Exception do
        begin
            Writeln(E.ClassName, ': ', E.Message);
            ReadLn;
        end;
    end;

end.

Answer 1

首先你的方法是错误的。继承接口然后添加{$M+}将仅包括从那里添加的方法的方法信息。这意味着即使你添加一个与父接口具有相同签名的方法也不会使模拟工作，因为代码仍将调用父接口方法而不是你添加的方法。

此外，在这种情况下，DelphiMocks是TValue将接口转换为其父类型的错误的受害者。这不受支持 - 请参阅Rtti.ConvIntf2Intf。

我建议使用继承自IInvokable的IEvent编译Spring4D，以获取方法信息并避免继承。

如果您这样做，以下测试将通过 - 所有其他测试只是传递模拟错误：

Test_InstanceAsValue;
Test_Value_From_Instance;
Test_Mocked_Container_Value_From;

在Spring4D 1.2中，我们引入了一个新的拦截库，它也用于我们的模拟解决方案。容器也可以提供自动锁定。所以你可以像这样编写你的测试：

var
  container: TContainer;
  event: IMyEvent;
begin
  container := TContainer.Create;
  container.AddExtension<TAutoMockExtension>;
  try
    FMyObject.EventContainer := container.Resolve<ITestEventContainer>;

    event := FMyObject.EventContainer.Event;
    event.Add(nil);
  finally
    container.Free;
  end;
end;

容器将为它不需要知道的任何类型创建模拟。在此测试中，您可以注册要测试的类，容器会自动将任何依赖项注入模拟。

var
  container: TContainer;
  event: IMyEvent;
begin
  container := TContainer.Create;
  container.AddExtension<TAutoMockExtension>;
  container.RegisterType<TMyObject>.InjectProperty('EventContainer');
  container.Build;
  try
    FMyObject := container.Resolve<TMyObject>;

    event := FMyObject.EventContainer.Event;
    event.Add(nil);
  finally
    container.Free;
  end;
end;

您可以更进一步，将auto mocking容器集成到基础测试用例类中：

program Project2;

{$APPTYPE CONSOLE}

uses
  Classes,
  SysUtils,
  DUnitTestRunner,
  TestFramework,
  Spring.Events,
  Spring,
  Spring.Container,
  Spring.Container.Registration,
  Spring.Container.AutoMockExtension,
  Spring.Mocking;

type
  IMyEvent = IEvent<TNotifyEvent>;

  IEventContainer = interface(IInvokable)
    function GetEvent: IMyEvent;
    procedure SetEvent(const Value: IMyEvent);
    property Event: IMyEvent read GetEvent write SetEvent;
  end;

  TMyObject = class(TObject)
  private
    FEventContainer: IEventContainer;
  public
    property EventContainer: IEventContainer read FEventContainer write FEventContainer;
  end;

  TAutoMockingTestCase<T: class> = class(TTestCase)
  protected
    fContainer: TContainer;
    fSUT: T;
    procedure SetUp; overload; override;
    procedure TearDown; override;
    procedure SetUp(const registration: TRegistration<T>); reintroduce; overload; virtual;
  end;

  TMyTest = class(TAutoMockingTestCase<TMyObject>)
  protected
    procedure SetUp(const registration: TRegistration<TMyObject>); override;
  published
    procedure Test_EventAdd;
  end;

procedure TAutoMockingTestCase<T>.SetUp(const registration: TRegistration<T>);
begin
end;

procedure TAutoMockingTestCase<T>.SetUp;
begin
  inherited;
  fContainer := TContainer.Create;
  fContainer.AddExtension<TAutoMockExtension>;
  SetUp(fContainer.RegisterType<T>);
  fContainer.Build;
  fSUT := fContainer.Resolve<T>;
end;

procedure TAutoMockingTestCase<T>.TearDown;
begin
  fSUT.Free;
  fContainer.Free;
  inherited;
end;

procedure TMyTest.SetUp(const registration: TRegistration<TMyObject>);
begin
  registration.InjectProperty('EventContainer');
end;

procedure TMyTest.Test_EventAdd;
begin
  fSUT.EventContainer.Event.Add(nil);
end;

begin
  RegisterTest(TMyTest.Suite);
  try
    DUnitTestRunner.RunRegisteredTests;
    ReadLn;
  except
    on E: Exception do
    begin
      Writeln(E.ClassName, ': ', E.Message);
      ReadLn;
    end;
  end;
end.