2

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!

SpanishBoy
  • 2,105
  • 6
  • 28
  • 51
  • Please provide more information about the exception you get. Also you might refer to our google group (you find the link on the Spring4D page). I might work better for helping you than the question/answer system on this page. – Stefan Glienke Jan 10 '15 at 10:14
  • Added details here and cross-link https://groups.google.com/forum/#!topic/spring4d/D7qPyWgcXLo – SpanishBoy Jan 10 '15 at 12:10
  • Please look at the callstack, where the exception occurs. Certainly not in the line you marked but somewhere inside the constructor. Also you wrote `procedure TCRMFrame.Create` somewhere. That certainly is not right. Please post the correct code so we don't have to guess. – Stefan Glienke Jan 10 '15 at 13:03

2 Answers2

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;
Stefan Glienke
  • 20,860
  • 2
  • 48
  • 102
  • Can we use any another Mocking framework instead Delphi-Mocks to avoid this crash? – SpanishBoy Jan 10 '15 at 22:54
  • You should report the error to them. But you can also try DSharp mocks (not sure if it can handle this use case though). And Spring4D has also mocking in the works but that is planned for 1.2. Additionally it will support auto mocking in the container so no need to register your mocks manually. – Stefan Glienke Jan 11 '15 at 00:08
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;
Vincent Parrett
  • 581
  • 5
  • 9