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;
The Wiert Corner - irregular stream of stuff 