Using a mock for a method with an open array parameter can cause a program fault

The problem occurs on Delphi 10 Seattle, Win32. On Win64 the problem doesn't show.

If you follow the steps below (see also code) a fault is caused. The program is unable to continue.

Mock an interface containing a method with an open array parameter
Pass the mocked interface to another instance
Use the passed mocked interface to call the method with the open array parameter and use for example the DateToStr function to fill the open array parameter. (passing a string constant causes no problems!)
raise an exception, only now will the program fault show.

The following tests show the unexpected behavior.

unit MockingOpenArrayProcedureCausingFault;

interface

uses
  SysUtils, DateUtils,
  TestFrameWork,
  Spring.Mocking;

type
  IFormatInterface = interface(IInvokable)
    ['{EDA2F1F1-98A4-4265-8369-91EC9DC258EC}']
    procedure LogFormat(const cFormatMessage: string; const args: array of const);
  end;

  TLogCaller = class
  private
    FLogger: IFormatInterface;
  public
    constructor Create(const logger: IFormatInterface);
    procedure CallLogFormat;
    procedure CallLogFormatCausingProblems;
  end;

  TFormatInterfaceTest = class(TTestCase)
  published
    procedure TestLoggingCaller;
    procedure TestLoggingCallerCausingFault;
  end;


implementation

{ TFormatInterfaceTest }

procedure TFormatInterfaceTest.TestLoggingCaller;
var
  logFormatMock: Mock<IFormatInterface>;
  caller: TLogCaller;
begin
  logFormatMock := Mock<IFormatInterface>.Create;
  caller := TLogCaller.Create(logFormatMock);
  try
    caller.CallLogFormat;
    Fail('fail on purpose, the raised exception will result in a fault');
  finally
    caller.Free;
  end;
end;

procedure TFormatInterfaceTest.TestLoggingCallerCausingFault;
var
  logFormatMock: Mock<IFormatInterface>;
  caller: TLogCaller;
begin
  logFormatMock := Mock<IFormatInterface>.Create;
  caller := TLogCaller.Create(logFormatMock);
  try
    caller.CallLogFormatCausingProblems;
    Fail('fail on purpose, the raised exception will result in a fault');
  finally
    caller.Free;
  end;
end;

{ TLogCaller }

procedure TLogCaller.CallLogFormatCausingProblems;
var
  dBluePrintDay: TDate;
begin
  dBluePrintDay := Today;
  FLogger.LogFormat('Reading fixed blueprints for %s', [DateTostr(Today)]);
end;

procedure TLogCaller.CallLogFormat;
begin
  FLogger.LogFormat('Reading fixed blueprints for %s', ['today']);
end;

constructor TLogCaller.Create(const logger: IFormatInterface);
begin
  inherited Create;
  FLogger := logger;
end;

initialization
  RegisterTest(TFormatInterfaceTest.Suite);

end.

Comments (3)