使用Delphi-Mocks和Spring4D在DUnit中模拟接口 [英] Mocking interfaces in DUnit with Delphi-Mocks and Spring4D

问题描述

因此，当尝试模拟第二个复合接口时，在使用Delphi-Mocks和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;

---

注册类型

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;

此处有完整的测试项目源- https://drive.google.com/file/d/0B6KvjsGVp4ONeXBNenlMc2J0R2M .同事，请告诉我我哪里错了.预先谢谢你！

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!

推荐答案

您需要在某个地方引用TMock，因为模拟是记录，当它们超出范围时将被清除.

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.

这应该有效:

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;

这篇关于使用Delphi-Mocks和Spring4D在DUnit中模拟接口的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！