The Wiert Corner – irregular stream of stuff

Jeroen W. Pluimers on .NET, C#, Delphi, databases, and personal interests

  • My badges

  • Twitter Updates

  • My Flickr Stream

  • Pages

  • All categories

  • Enter your email address to subscribe to this blog and receive notifications of new posts by email.

    Join 2,483 other followers

DUnit testing code that should raise a specific exception

Posted by jpluimers on 2021/02/17

A while back, I was writing some code to demonstrate a few inner workings of TInterfacedObject, interface reference counting and mixing object references with interface references.

One way to show this is through a test case that expects a certain exception to happen, but I forgot how to do that in DUnit. Luckily this pointed me on the right track: [WayBack] delphi – CheckException only accepts 0-parameter methods; how do I test that other methods throw exceptions? – Stack Overflow.

The solution shows that DUnit has had support for something similar as DUnitX: now has a WillRaiseAttribute to ease defining tests around code that should throw exceptions for a very long time (I think this was introduced around Delphi 2005).

You can do it in a property way:

unit InterfacedObjectTestCaseUnit;

interface

uses
  TestFramework;

type
  TDebuggableInterfacedObjectTestCase = class(TTestCase)
  published
    procedure System_TInterfacedObject_Free_Before_RefCount_Should_Raise_EInvalidPointer();
  end;

implementation

uses
  System.SysUtils,

procedure TInterfacedObjectTestCase.System_TInterfacedObject_Free_Before_RefCount_Should_Raise_EInvalidPointer();
var
  ObjectReference:    System.TInterfacedObject;
  InterfaceReference: IInterface;
begin
  ObjectReference    := System.TInterfacedObject.Create();
  InterfaceReference := ObjectReference;
  ExpectedException  := System.SysUtils.EInvalidPointer;
  ObjectReference.Free(); // this should raise an exception in System.TInterfacedObject.BeforeDestruction, as it checks the RefCount to be zero
  // the below is optional; should not be reached. If it is reached, it will fail earlier than the encompassing `RunTest` method would
  ExpectedException := nil; // or `StopExpectingException();`
end;

end.

or in a method way for an exception that happens in the current method:

procedure TInterfacedObjectTestCase.System_TInterfacedObject_Free_Before_RefCount_Should_Raise_EInvalidPointer();
var
  ObjectReference:    System.TInterfacedObject;
  InterfaceReference: IInterface;
begin
  ObjectReference    := System.TInterfacedObject.Create();
  InterfaceReference := ObjectReference;
  StartExpectingException(System.SysUtils.EInvalidPointer);
  ObjectReference.Free(); // this should raise an exception in System.TInterfacedObject.BeforeDestruction, as it checks the RefCount to be zero
  // the below is optional; should not be reached. If it is reached, it will fail earlier than the encompassing `RunTest` method would
  StopExpectingException();
end;

The alternative using CheckException that will raise earlier, but also tests the results of a complete method which also has to be parameterless:

procedure TDebuggableInterfacedObjectTestCase.System_TInterfacedObject_Free_Before_RefCount();
var
  ObjectReference:    System.TInterfacedObject;
  InterfaceReference: IInterface;
begin
  ObjectReference    := System.TInterfacedObject.Create();
  InterfaceReference := ObjectReference;
  ObjectReference.Free(); // this should raise an exception in System.TInterfacedObject.BeforeDestruction, as it checks the RefCount to be zero
end;

procedure TDebuggableInterfacedObjectTestCase.System_TInterfacedObject_Free_Before_RefCount_Should_Raise_EInvalidPointer_TTestMethod_Based();
begin
  CheckException(System_TInterfacedObject_Free_Before_RefCount, System.SysUtils.EInvalidPointer);
end;

So I wrote a class helper based on TProc that allows you to test an anonymous method which usually has more fine grained testing potential.

Because of type compatibility, you have to call the inherited version of CheckException inside the new one:

unit TestCaseHelperUnit;

interface

uses
  System.SysUtils,
  TestFramework;

type
  TTestCaseHelper = class helper for TTestCase
  public
    procedure CheckException(const AProc: TProc; const AExceptionClass: TClass; const msg: string = '');
  end;

implementation

type
  TTestCaseInvoker = class
  strict private
    FProc: TProc;
  public
    constructor Create(const AProc: TProc);
    procedure Execute();
  end;

{ TTestCaseInvoker }

constructor TTestCaseInvoker.Create(const AProc: TProc);
begin
  inherited Create();
  FProc := AProc;
end;

procedure TTestCaseInvoker.Execute();
begin
  if Assigned(FProc) then
    FProc();
end;

procedure TTestCaseHelper.CheckException(const AProc: TProc; const AExceptionClass: TClass; const msg: string = '');
var
  TestCaseInvoker: TTestCaseInvoker;
begin
  TestCaseInvoker := TTestCaseInvoker.Create(AProc);
  try
    inherited CheckException(TestCaseInvoker.Execute, AExceptionClass, msg); // `inherited`, to avoid stack overflow because `TProc` is compatible with `TTestMethod`
  finally
    TestCaseInvoker.Free();
  end;
end;

end.

The test then becomes this:

procedure TDebuggableInterfacedObjectTestCase.System_TInterfacedObject_Free_Before_RefCount_Should_Raise_EInvalidPointer_TProc_Based();
var
  ObjectReference:    System.TInterfacedObject;
  InterfaceReference: IInterface;
begin
  ObjectReference    := System.TInterfacedObject.Create();
  InterfaceReference := ObjectReference;
  CheckException(procedure ()
  begin
    ObjectReference.Free(); // this should raise an exception in System.TInterfacedObject.BeforeDestruction, as it checks the RefCount to be zero
  end,
  System.SysUtils.EInvalidPointer);
end;

DUnit code snippets

Inside TAbstractTest:

unit TestFramework;

interface

type
  TAbstractTest = class(TInterfacedObject, ITest)
  protected
    FExpectedException: ExceptionClass;
  public
    procedure StartExpectingException(e: ExceptionClass);
    procedure StopExpectingException(msg :string = '');
    property ExpectedException: ExceptionClass read fExpectedException write StartExpectingException;
  end;

implementation

procedure TAbstractTest.StartExpectingException(e: ExceptionClass);
begin
  StopExpectingException;
  FExpectedException := e;
end;

procedure TAbstractTest.StopExpectingException(msg :string);
begin
  try
    if FExpectedException <> nil then
    begin
      Fail( Format( sExpectedException,
                                        [FExpectedException.ClassName,
                                        Msg]),
                                        ReturnAddress);
    end;
  finally
    FExpectedException := nil;
  end;
end;

end.

and the derived TTestCase class:

unit TestFramework;

interface

type
  TTestCase = class(TAbstractTest, ITest)
  protected
    procedure RunTest(testResult: TTestResult); override;
  end;

implementation

procedure TTestCase.RunTest(testResult: TTestResult);
var
  i:integer;
begin
  assert(assigned(FMethod), sMethodNotFound + FTestName + '" ');
  FExpectedException := nil;
  try
    try
{$IFDEF CLR}
      testResult.FMethodPtr := nil;
{$ELSE}
      CheckMethodIsNotEmpty(tMethod(FMethod).Code);
      testResult.FMethodPtr := tMethod(FMethod).Code;
{$ENDIF}
      FCheckCalled := False;
                                                                                 
      {$IFDEF _USE_SYSDEBUG_}
      {$IFNDEF CLR}
      SysDebug('Enter %s, %d',[Name, FRunCount]);
      {$ENDIF !CLR}
      {$ENDIF _USE_SYSDEBUG_}
      for i := 1 to FRunCount do
        Invoke(FMethod);
      {$IFDEF _USE_SYSDEBUG_}
      {$IFNDEF CLR}
      SysDebug('Leave %s',[Name]);
      {$ENDIF !CLR}
      {$ENDIF _USE_SYSDEBUG_}
      if FFailsOnNoChecksExecuted and (not FCheckCalled) then
        Fail(sNoChecksExecuted, testResult.FMethodPtr);
      StopExpectingException;
    except
      on E: ETestFailure  do
      begin
        raise;
      end;
      on E: Exception  do
      begin
        if  not Assigned(FExpectedException) then
          raise
        else if not E.ClassType.InheritsFrom(fExpectedException) then
          FailNotEquals(fExpectedException.ClassName, E.ClassName, sExceptionUnexpected, ExceptAddr);
      end;
    end;
  finally
    FExpectedException := nil;
  end;
end;

end.

Via [Archive.is] delphi “dunit” test to see if exception is raised – Google Search

–jeroen

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

This site uses Akismet to reduce spam. Learn how your comment data is processed.

 
%d bloggers like this: