paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 16:29:21 +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; FRaisedExceptionClass: TClass;
FRaisedExceptionMessage: string; FRaisedExceptionMessage: string;
FSourceUnitName: string; FSourceUnitName: string;
FThrownExceptionAddress: Pointer;
FTestLastStep: TTestStep; FTestLastStep: TTestStep;
function GetAsString: string; function GetAsString: string;
function GetExceptionMessage: string; function GetExceptionMessage: string;
function GetIsFailure: boolean; function GetIsFailure: boolean;
function GetIsIgnoredTest: boolean; function GetIsIgnoredTest: boolean;
function GetExceptionClassName: string; function GetExceptionClassName: string;
function GetLocationInfo: string;
procedure SetTestLastStep(const Value: TTestStep); procedure SetTestLastStep(const Value: TTestStep);
public 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; property ExceptionClass: TClass read FRaisedExceptionClass;
published published
property AsString: string read GetAsString; property AsString: string read GetAsString;
@ -162,6 +164,7 @@ type
property ExceptionClassName: string read GetExceptionClassName; property ExceptionClassName: string read GetExceptionClassName;
property SourceUnitName: string read FSourceUnitName write FSourceUnitName; property SourceUnitName: string read FSourceUnitName write FSourceUnitName;
property LineNumber: longint read FLineNumber write FLineNumber; property LineNumber: longint read FLineNumber write FLineNumber;
property LocationInfo: string read GetLocationInfo;
property FailedMethodName: string read FFailedMethodName write FFailedMethodName; property FailedMethodName: string read FFailedMethodName write FFailedMethodName;
property TestLastStep: TTestStep read FTestLastStep write SetTestLastStep; property TestLastStep: TTestStep read FTestLastStep write SetTestLastStep;
end; end;
@ -405,13 +408,14 @@ begin
end; end;
constructor TTestFailure.CreateFailure(ATest: TTest; E: Exception; LastStep: TTestStep); constructor TTestFailure.CreateFailure(ATest: TTest; E: Exception; LastStep: TTestStep; ThrownExceptionAddrs: pointer);
begin begin
inherited Create; inherited Create;
FTestName := ATest.GetTestName; FTestName := ATest.GetTestName;
FTestSuiteName := ATest.GetTestSuiteName; FTestSuiteName := ATest.GetTestSuiteName;
FRaisedExceptionClass := E.ClassType; FRaisedExceptionClass := E.ClassType;
FRaisedExceptionMessage := E.Message; FRaisedExceptionMessage := E.Message;
FThrownExceptionAddress := ThrownExceptionAddrs;
FTestLastStep := LastStep; FTestLastStep := LastStep;
end; end;
@ -436,6 +440,11 @@ begin
Result := '<NIL>' Result := '<NIL>'
end; end;
function TTestFailure.GetLocationInfo: string;
begin
Result := PointerToLocationInfo(FThrownExceptionAddress);
end;
function TTestFailure.GetExceptionMessage: string; function TTestFailure.GetExceptionMessage: string;
begin begin