Mocking interfaces in DUnit with Delphi-Mocks and Spring4D

问题

So, I am getting Access Violation error when try to Mock 2-nd composite interface, below examples of code with using Delphi-Mocks and Spring4D frameworks

unit u_DB;
type
 TDBObject = class
 public
   property ID: TGUID;
 end;

 TDBCRM = class(TDBObject)
 public
   property SOME_FIELD: TSomeType;
 end;

unit i_dmServer;
type
  {$M+}
  IdmServer = interface
  ['{A4475441-9651-4956-8310-16FB710EAE5E}']
    function GetServiceConnection: TServiceConnection;
    function GetCurrentUser(): TUser;
  end;

unit d_ServerWrapper;
type
  TdmServerWrapper = class(TInterfacedObject, IdmServer)
  private
    function GetServiceConnection: TServiceConnection;
    function GetCurrentUser(): TUser;
  protected
    FdmServer: TdmServer;
  end;

implementation

constructor TdmServerWrapper.Create();
begin
  inherited Create();
  FdmServer := TdmServer.Create(nil);
end;
end.

unit i_BaseDAL;
type
  {$M+}
  IBaseDAL<T: TDBObject, constructor> = interface
  ['{56D48844-BD7F-4FF8-A4AE-30DA1A82AD67}']
    procedure RefreshData(); ....
  end;

unit u_BaseDAL;
type
  TBaseDAL<T: TDBObject, constructor> = class(TInterfacedObject, IBaseDAL<TDBObject>)
  protected

    FdmServer: IdmServer;

  public
    procedure RefreshData();
  end;

implementation

procedure TBaseDAL<T>.Create;
begin
  FdmServer := GlobalContainer.Resolve<IdmServer>;
end;

end.

unit ChildFrame;

interface

type

  TChildFrame = class(TFrame)
  private
    fDM: IBaseDAL<TDBObject>;
    function GetDM: IBaseDAL<TDBObject>;
    procedure SetDM(const Value: IBaseDAL<TDBObject>);
  public
    constructor Create(AOwner: TComponent); override;
    property DM: IBaseDAL<TDBObject> read GetDM write SetDM;
  end;

implementation

constructor TChildFrame.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  DM := nil;
end;

function TChildFrame.GetDM: IBaseDAL<TDBObject>;
begin
  if not Assigned(fDM) then
    fDM := GlobalContainer.Resolve<IBaseDAL<TDBObject>>;
  Result := fDM;
end;

procedure TfrmCustomChildFrame.SetDM(const Value: IBaseDAL<TDBObject>);
begin
  if Assigned(fDM) then
    fDM := nil;
  fDM := Value;
end;
end.

TCRMFrame = class(TChildFrame)
  ....
end;

procedure TCRMFrame.Create
begin
 DM := GlobalContainer.Resolve('i_BaseDAL.IBaseDAL<u_DB.TDBObject>@TBaseDAL<u_DB.TDBCRM>').AsInterface as IBaseDAL<TDBObject>;
  // DM := GlobalContainer.Resolve(IBaseDAL<TomDBObject>); {Not compiled et all: "E2250 There is no overloaded version of 'Resolve' that can be called with these arguments"}
end;

REGISTERING TYPES

unit RegisteringTypes.pas

procedure RegTypes;

implementation

procedure RegTypes;
begin
  GlobalContainer.RegisterType<TdmServerWrapper>;
  GlobalContainer.RegisterType<TBaseDAL<TDBObject>, IBaseDAL<TDBObject>>;
  GlobalContainer.RegisterType<TBaseDAL<TDBCRM>, IBaseDAL<TDBCRM>>;

  GlobalContainer.Build;
end;

initialization
  RegTypes
end.

DUNIT TEST

type
  TestTCRM = class(TTestCase)
  private
    FFrame: TCRMFrame;
    FBaseDALMock: TMock<TBaseDAL<TDBObject>>;
    procedure Init;

  protected
    procedure SetUp; override;
  published
  end;

implementation

procedure TestTCRM.Init;
begin
  inherited;
  GlobalContainer.RegisterType<IdmServer>.DelegateTo(
    function: IdmServer
    begin
      Result := TMock<IdmServer>.Create;
    end
  );

  GlobalContainer.RegisterType<IBaseDAL<TDBCRM>>.DelegateTo(
    function: IBaseDAL<TDBCRM>
    begin
      Result := TMock<IBaseDAL<TDBCRM>>.Create;
    end
  );

  GlobalContainer.RegisterType<IBaseDAL<TDBObject>>.DelegateTo(
    function: IBaseDAL<TDBObject>
    begin
      Result := TMock<IBaseDAL<TDBObject>>.Create;
    end
  );

  GlobalContainer.Build;
end;

procedure TestTfrCRMAccountClasses.SetUp;
begin
  inherited;
  Init;
  FFrame := TCRMFrame.Create(nil); // and I got ACCESS VIOLATION HERE
end;

Full sources of test project here - https://drive.google.com/file/d/0B6KvjsGVp4ONeXBNenlMc2J0R2M. Colleagues, please advise me where I am wrong. Thank you in advance!

回答1:

You need to have a reference to the TMock somewhere, because the mocks are records which will get cleaned up when they go out of scope.

This should work :

procedure DelphiMocksTest;
var
  func: TFunc<IdmServer>;
  dm: IdmServer;
  i: IInitializable;
  mock : TMock<IdmServer>;
begin
  func := function: IdmServer
  begin
    mock := TMock<IdmServer>.Create;
    Supports(dm, IInitializable, i); // works
    result := mock; 
  end; 
  dm := func();
  Supports(dm, IInitializable, i); // fails
end;

回答2:

The AV is raised from Delphi.Mocks.

Here is a minimal test case to reproduce it:

procedure DelphiMocksTest;
var
  func: TFunc<IdmServer>;
  dm: IdmServer;
  i: IInitializable;
begin
  func :=
    function: IdmServer
    begin
      Result := TMock<IdmServer>.Create;
      Supports(dm, IInitializable, i); // works
    end; // TMock record goes out of scope and something happens
  dm := func();
  Supports(dm, IInitializable, i); // fails
end;

来源：https://stackoverflow.com/questions/27874168/mocking-interfaces-in-dunit-with-delphi-mocks-and-spring4d

标签

Delphi

delphi-xe7

spring4d

delphi-mocks