Browse Source

* Patch from Graeme Geldenhuys to add exception address to addfailure/adderror

git-svn-id: trunk@30318 -
michael 10 years ago
parent
commit
5271c7674a
1 changed files with 9 additions and 23 deletions
  1. 9 23
      packages/fcl-fpcunit/src/fpcunit.pp

+ 9 - 23
packages/fcl-fpcunit/src/fpcunit.pp

@@ -269,9 +269,8 @@ type
     destructor Destroy; override;
     destructor Destroy; override;
     procedure ClearErrorLists;
     procedure ClearErrorLists;
     procedure StartTest(ATest: TTest);
     procedure StartTest(ATest: TTest);
-    procedure AddFailure(ATest: TTest; E: EAssertionFailedError; aFailureList: TFPList);
-    procedure AddError(ATest: TTest; E: Exception; AUnitName: string;
-      AFailedMethodName: string; ALineNumber: longint);
+    procedure AddFailure(ATest: TTest; E: EAssertionFailedError; aFailureList: TFPList; AThrownExceptionAdrs: Pointer);
+    procedure AddError(ATest: TTest; E: Exception; AThrownExceptionAdrs: Pointer);
     procedure EndTest(ATest: TTest);
     procedure EndTest(ATest: TTest);
     procedure AddListener(AListener: ITestListener);
     procedure AddListener(AListener: ITestListener);
     procedure RemoveListener(AListener: ITestListener);
     procedure RemoveListener(AListener: ITestListener);
@@ -1243,13 +1242,13 @@ begin
 end;
 end;
 
 
 
 
-procedure TTestResult.AddFailure(ATest: TTest; E: EAssertionFailedError; aFailureList: TFPList);
+procedure TTestResult.AddFailure(ATest: TTest; E: EAssertionFailedError; aFailureList: TFPList; AThrownExceptionAdrs: Pointer);
 var
 var
   i: integer;
   i: integer;
   f: TTestFailure;
   f: TTestFailure;
 begin
 begin
   //lock mutex
   //lock mutex
-  f := TTestFailure.CreateFailure(ATest, E, ATest.LastStep);
+  f := TTestFailure.CreateFailure(ATest, E, ATest.LastStep, AThrownExceptionAdrs);
   aFailureList.Add(f);
   aFailureList.Add(f);
   for i := 0 to FListeners.Count - 1 do
   for i := 0 to FListeners.Count - 1 do
     ITestListener(FListeners[i]).AddFailure(ATest, f);
     ITestListener(FListeners[i]).AddFailure(ATest, f);
@@ -1257,17 +1256,13 @@ begin
 end;
 end;
 
 
 
 
-procedure TTestResult.AddError(ATest: TTest; E: Exception;
-  AUnitName: string; AFailedMethodName: string; ALineNumber: longint);
+procedure TTestResult.AddError(ATest: TTest; E: Exception; AThrownExceptionAdrs: Pointer);
 var
 var
   i: integer;
   i: integer;
   f: TTestFailure;
   f: TTestFailure;
 begin
 begin
   //lock mutex
   //lock mutex
-  f := TTestFailure.CreateFailure(ATest, E, ATest.LastStep);
-  f.SourceUnitName := AUnitName;
-  f.FailedMethodName := AFailedMethodName;
-  f.LineNumber := ALineNumber;
+  f := TTestFailure.CreateFailure(ATest, E, ATest.LastStep, AThrownExceptionAdrs);
   FErrors.Add(f);
   FErrors.Add(f);
   for i := 0 to FListeners.Count - 1 do
   for i := 0 to FListeners.Count - 1 do
     ITestListener(FListeners[i]).AddError(ATest, f);
     ITestListener(FListeners[i]).AddError(ATest, f);
@@ -1302,26 +1297,17 @@ end;
 
 
 
 
 procedure TTestResult.RunProtected(ATestCase: TTest; protect: TProtect);
 procedure TTestResult.RunProtected(ATestCase: TTest; protect: TProtect);
-var
-  func, source: shortstring;
-  line: longint;
 begin
 begin
-  func := '';
-  source := '';
-  line := 0;
   try
   try
     protect(ATestCase, Self);
     protect(ATestCase, Self);
   except
   except
     on E: EIgnoredTest do
     on E: EIgnoredTest do
-      AddFailure(ATestCase, E, FIgnoredTests);
+      AddFailure(ATestCase, E, FIgnoredTests, ExceptAddr);
     on E: EAssertionFailedError do
     on E: EAssertionFailedError do
-      AddFailure(ATestCase, E, FFailures);
+      AddFailure(ATestCase, E, FFailures, ExceptAddr);
     on E: Exception do
     on E: Exception do
       begin
       begin
-      {$ifdef SHOWLINEINFO}
-        GetLineInfo(LongWord(ExceptAddr), func, source, line);
-      {$endif}
-        AddError(ATestCase, E, source, func, line);
+        AddError(ATestCase, E, ExceptAddr);
       end;
       end;
   end;
   end;
 end;
 end;