Commits

Shinya Okano  committed 7d39f08

impl: AssertRaises

  • Participants
  • Parent commits d60819e

Comments (0)

Files changed (3)

File Example/MyUnit1.pas

 
 interface
 
+uses
+  System.SysUtils
+  ;
+
+type
+  TMyException1 = class(Exception)
+  end;
+
 function Add(A, B: Integer): Integer;
 function Sub(A, B: Integer): Integer;
 function Add64(A, B: Int64): Int64;
 function JoinString(A, B: ShortString): ShortString; overload;
 function JoinString(A, B: String): String; overload;
 function JoinString(A, B: RawByteString): RawByteString; overload;
+procedure RaiseException;
 
 implementation
 
   Result := A + B;
 end;
 
+procedure RaiseException;
+begin
+  raise TMyException1.Create('MyException1 raised.');
+end;
+
 end.

File Example/MyUnit1Test.pas

     procedure TestSlow;
     procedure TestAdd64;
     procedure TestJoinString;
+    procedure TestRaiseException;
   end;
 
 implementation
   AssertEquals(JoinString('foo', 'bar'), 'foobar');
 end;
 
+procedure TMyUnit1Test.TestRaiseException;
+begin
+  AssertRaises(TMyException1,
+    procedure
+    begin
+      RaiseException;
+    end
+  );
+end;
+
 initialization
   RegisterTest(TMyUnit1Test);
 

File Nullpobug.UnitTest.pas

   end;
 
   TOnRanTestMethod = procedure(TestResult: TTestResult) of object;
+  TTestProc = reference to procedure;
+  TExceptionClass = class of Exception;
 
   TTestCase = class(TObject)
   private
     procedure AssertEquals(Value1, Value2: RawByteString); overload; virtual;
     procedure AssertIsNil(Value: TObject); virtual;
     procedure AssertIsNotNil(Value: TObject); virtual;
+    procedure AssertRaises(ExceptionClass: TExceptionClass; Proc: TTestProc); overload; virtual;
     procedure Run(TestResultList: TObjectList<TTestResult>); virtual;
     property OnRanTestMethod: TOnRanTestMethod read FOnRanTestMethod write FOnRanTestMethod;
   end;
     raise EAssertionError.CreateFmt('%s is nil.', [Value.ToString]);
 end;
 
+procedure TTestCase.AssertRaises(ExceptionClass: TExceptionClass; Proc: TTestProc);
+var
+  Raised: Boolean;
+begin
+  Raised := False;
+  try
+    Proc;
+  except
+    on E: Exception do
+    begin
+      if not Assigned(ExceptionClass) then
+          raise
+        else if E.ClassType.InheritsFrom(ExceptionClass) then
+          Raised := True;
+    end;
+  end;
+  if not Raised then
+    raise EAssertionError.CreateFmt('%s is not raised.', [ExceptionClass.ClassName]);
+end;
+
 procedure TTestCase.Run(TestResultList: TObjectList<TTestResult>);
 var
   RttiContext: TRttiContext;