paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 04:29:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

* TTestFailure now has address information

Browse Source 
git-svn-id: trunk@30312 -
This commit is contained in:
michael 2015-03-24 13:32:35 +00:00
parent 8ee96289fc
commit 20aeb0e0ad
1 changed files with 11 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
packages/fcl-fpcunit/src/fpcunit.pp
View File

@ -144,15 +144,17 @@ type
FRaisedExceptionClass: TClass;
FRaisedExceptionMessage: string;
FSourceUnitName: string;
FThrownExceptionAddress: Pointer;
FTestLastStep: TTestStep;
function GetAsString: string;
function GetExceptionMessage: string;
function GetIsFailure: boolean;
function GetIsIgnoredTest: boolean;
function GetExceptionClassName: string;
function GetLocationInfo: string;
procedure SetTestLastStep(const Value: TTestStep);
public
constructor CreateFailure(ATest: TTest; E: Exception; LastStep: TTestStep);
constructor CreateFailure(ATest: TTest; E: Exception; LastStep: TTestStep; ThrownExceptionAddrs: pointer = nil);
property ExceptionClass: TClass read FRaisedExceptionClass;
published
property AsString: string read GetAsString;
@ -162,6 +164,7 @@ type
property ExceptionClassName: string read GetExceptionClassName;
property SourceUnitName: string read FSourceUnitName write FSourceUnitName;
property LineNumber: longint read FLineNumber write FLineNumber;
property LocationInfo: string read GetLocationInfo;
property FailedMethodName: string read FFailedMethodName write FFailedMethodName;
property TestLastStep: TTestStep read FTestLastStep write SetTestLastStep;
end;
@ -405,13 +408,14 @@ begin
end;
constructor TTestFailure.CreateFailure(ATest: TTest; E: Exception; LastStep: TTestStep);
constructor TTestFailure.CreateFailure(ATest: TTest; E: Exception; LastStep: TTestStep; ThrownExceptionAddrs: pointer);
begin
inherited Create;
FTestName := ATest.GetTestName;
FTestSuiteName := ATest.GetTestSuiteName;
FRaisedExceptionClass := E.ClassType;
FRaisedExceptionMessage := E.Message;
FThrownExceptionAddress := ThrownExceptionAddrs;
FTestLastStep := LastStep;
end;
@ -436,6 +440,11 @@ begin
Result := '<NIL>'
end;
function TTestFailure.GetLocationInfo: string;
begin
Result := PointerToLocationInfo(FThrownExceptionAddress);
end;
function TTestFailure.GetExceptionMessage: string;
begin