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
The Wiert Corner - irregular stream of stuff 
Leave a comment