Question

所以，我在尝试使用Mock 2-nd复合接口时遇到了Access Violation错误，下面是使用Delphi-Mocks和Spring4D框架的代码示例

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。同事们，请告诉我我哪里错了。提前谢谢！

Answer 1

AV来自Delphi.Mocks。

这是一个重现它的最小测试用例：

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;

Answer 2

你需要在某个地方引用TMock，因为模拟是在超出范围时会被清理的记录。

这应该有效：

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中的接口

2 个答案: