How to Mock Spring4D Events with DUnit - unit-testing

Question

I am struggling to successfully mock a Spring4d Event with DUnit.
In fact I am more mocking a mock returning a mock of an event...
This is the basic structure.
TMyObject --EventContainer--> TMock<IEventContainer> --Event--> TMock<IEvent>
TMyObject has a property EventContainer : IEventContainer
IEventContainer has a property Event : IMyEvent
I want to mock
MyObject.EventContainer.Event.Add
I tested each possibility I could think of. I either get AVs or Invalid Casts. I've put the source code below. If anyone could help me to get this working that would be really nifty!
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

First your approach is wrong. Inheriting an interface and then adding {$M+} will only include method info for the methods added from there on. That means even if you add a method with the same signature as a parent interface has will not make the mock work because the code will still call the parent interfaces method and not the one you added.
Furthermore DelphiMocks in this case is the victim of a bug in TValue conversion of an interface to its parent type. This is just not supported - see Rtti.ConvIntf2Intf.
I would suggest compiling Spring4D with IEvent inheriting from IInvokable to get method info in there and avoid inheriting from it.
If you do that the following tests will pass - all others are just passing the mock wrong:
Test_InstanceAsValue;
Test_Value_From_Instance;
Test_Mocked_Container_Value_From;
In Spring4D 1.2 we are introducing a new interception library that is also used for our mocking solution. Also the container will be able to provide automocking. So you can write your test like this:
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;
The container will create mocks for any type it needs to resolve that it does not know. In this test you could register the class you want to test and the container automatically injects any dependency as mock.
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;
You can go even further and integrate the auto mocking container into a base testcase class:
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.