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

* Use caller addr info wherever needed.

Browse Source 
git-svn-id: trunk@30361 -
This commit is contained in:
michael 2015-03-29 09:32:29 +00:00
parent e8da5e1170
commit 1720d05d44
1 changed files with 96 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -84,9 +84,9 @@ type
class procedure FailEquals(const expected, actual: string; const ErrorMsg: string = ''; AErrorAddrs: Pointer = nil); class procedure FailEquals(const expected, actual: string; const ErrorMsg: string = ''; AErrorAddrs: Pointer = nil);
class procedure FailNotEquals(const expected, actual: string; const ErrorMsg: string = ''; AErrorAddrs: Pointer = nil); class procedure FailNotEquals(const expected, actual: string; const ErrorMsg: string = ''; AErrorAddrs: Pointer = nil);
class procedure AssertTrue(const AMessage: string; ACondition: boolean); overload; class procedure AssertTrue(const AMessage: string; ACondition: boolean; AErrorAddrs: Pointer = nil); overload;
class procedure AssertTrue(ACondition: boolean); overload; class procedure AssertTrue(ACondition: boolean); overload;
class procedure AssertFalse(const AMessage: string; ACondition: boolean); overload; class procedure AssertFalse(const AMessage: string; ACondition: boolean; AErrorAddrs: Pointer = nil); overload;
class procedure AssertFalse(ACondition: boolean); overload; class procedure AssertFalse(ACondition: boolean); overload;
class procedure AssertEquals(const AMessage: string; Expected, Actual: string); overload; class procedure AssertEquals(const AMessage: string; Expected, Actual: string); overload;
class procedure AssertEquals(Expected, Actual: string); overload; class procedure AssertEquals(Expected, Actual: string); overload;
@ -130,8 +130,8 @@ type
class procedure AssertNull(APointer: Pointer); overload; class procedure AssertNull(APointer: Pointer); overload;
class procedure AssertNotNull(const AMessage, AString: string); overload; class procedure AssertNotNull(const AMessage, AString: string); overload;
class procedure AssertNotNull(const AString: string); overload; class procedure AssertNotNull(const AString: string); overload;
class procedure AssertException(const AMessage: string; AExceptionClass: ExceptClass; AMethod: TRunMethod); overload; class procedure AssertException(const AMessage: string; AExceptionClass: ExceptClass; AMethod: TRunMethod;AExceptionMessage : String = ''; AExceptionContext : Integer = 0; AErrorAddr : Pointer = Nil); overload;
class procedure AssertException(AExceptionClass: ExceptClass; AMethod: TRunMethod); overload; class procedure AssertException(AExceptionClass: ExceptClass; AMethod: TRunMethod;AExceptionMessage : String = ''; AExceptionContext : Integer = 0); overload;
{$IFDEF DUnit} {$IFDEF DUnit}
{$I DUnitCompatibleInterface.inc} {$I DUnitCompatibleInterface.inc}
@ -193,6 +193,7 @@ type
FExpectedException : TClass; FExpectedException : TClass;
FExpectedExceptionMessage: String; FExpectedExceptionMessage: String;
FExpectedExceptionContext: Integer; FExpectedExceptionContext: Integer;
FExpectedExceptionCaller : Pointer;
protected protected
function CreateResult: TTestResult; virtual; function CreateResult: TTestResult; virtual;
procedure SetUp; virtual; procedure SetUp; virtual;
@ -378,6 +379,15 @@ begin
Result := AddrsToStr(Addrs) + ' <no map file>'; Result := AddrsToStr(Addrs) + ' <no map file>';
end; end;
// Get the ClassName of C
function GetN(C : TClass) : string;
begin
if C=Nil then
Result:='<NIL>'
else
Result:=C.ClassName;
end;
type type
@ -559,53 +569,58 @@ begin
Fail(NotEqualsErrorMessage(expected, actual, ErrorMsg), AErrorAddrs); Fail(NotEqualsErrorMessage(expected, actual, ErrorMsg), AErrorAddrs);
end; end;
class procedure TAssert.AssertTrue(const AMessage: string; ACondition: boolean); class procedure TAssert.AssertTrue(const AMessage: string; ACondition: boolean; AErrorAddrs: Pointer = nil);
begin begin
if AErrorAddrs=Nil then
AErrorAddrs:=CallerAddr;
if (not ACondition) then if (not ACondition) then
Fail(AMessage); Fail(AMessage,AErrorAddrs);
end; end;
class procedure TAssert.AssertTrue(ACondition: boolean); class procedure TAssert.AssertTrue(ACondition: boolean);
begin begin
AssertTrue('', ACondition); AssertTrue('', ACondition,CallerAddr);
end; end;
class procedure TAssert.AssertFalse(const AMessage: string; ACondition: boolean class procedure TAssert.AssertFalse(const AMessage: string; ACondition: boolean; AErrorAddrs: Pointer = nil
); );
begin begin
AssertTrue(AMessage, not ACondition); if AErrorAddrs=Nil then
AErrorAddrs:=CallerAddr;
AssertTrue(AMessage, not ACondition,AErrorAddrs);
end; end;
class procedure TAssert.AssertFalse(ACondition: boolean); class procedure TAssert.AssertFalse(ACondition: boolean);
begin begin
AssertFalse('', ACondition); AssertFalse('', ACondition,CallerAddr);
end; end;
class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: string); class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: string);
begin begin
AssertTrue(ComparisonMsg(AMessage ,Expected, Actual), AnsiCompareStr(Expected, Actual) = 0); AssertTrue(ComparisonMsg(AMessage ,Expected, Actual), AnsiCompareStr(Expected, Actual) = 0,CallerAddr);
end; end;
class procedure TAssert.AssertEquals(Expected, Actual: string); class procedure TAssert.AssertEquals(Expected, Actual: string);
begin begin
AssertEquals('', Expected, Actual); AssertTrue(ComparisonMsg(Expected, Actual), AnsiCompareStr(Expected, Actual) = 0,CallerAddr);
end; end;
{$IFDEF UNICODE} {$IFDEF UNICODE}
class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: UnicodeString); class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: UnicodeString);
begin begin
AssertTrue(ComparisonMsg(AMessage,Expected, Actual), (Expected=Actual)); AssertTrue(ComparisonMsg(AMessage,Expected, Actual), (Expected=Actual),CallerAddr);
end; end;
class procedure TAssert.AssertEquals(Expected, Actual: UnicodeString); class procedure TAssert.AssertEquals(Expected, Actual: UnicodeString);
begin begin
AssertEquals('', Expected, Actual); AssertTrue(ComparisonMsg(Expected, Actual), (Expected=Actual),CallerAddr);
end; end;
{$ENDIF} {$ENDIF}
@ -617,254 +632,256 @@ end;
class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: integer); class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: integer);
begin begin
AssertTrue(ComparisonMsg(AMessage,IntToStr(Expected), IntToStr(Actual)), Expected = Actual); AssertTrue(ComparisonMsg(AMessage,IntToStr(Expected), IntToStr(Actual)), Expected = Actual,CallerAddr);
end; end;
class procedure TAssert.AssertEquals(Expected, Actual: integer); class procedure TAssert.AssertEquals(Expected, Actual: integer);
begin begin
AssertEquals('', Expected, Actual); AssertTrue(ComparisonMsg(IntToStr(Expected), IntToStr(Actual)), Expected = Actual,CallerAddr);
end; end;
class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: int64); class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: int64);
begin begin
AssertTrue(ComparisonMsg(AMessage,IntToStr(Expected), IntToStr(Actual)), Expected = Actual); AssertTrue(ComparisonMsg(AMessage,IntToStr(Expected), IntToStr(Actual)), Expected = Actual,CallerAddr);
end; end;
class procedure TAssert.AssertEquals(Expected, Actual: int64); class procedure TAssert.AssertEquals(Expected, Actual: int64);
begin begin
AssertEquals('', Expected, Actual); AssertTrue(ComparisonMsg(IntToStr(Expected), IntToStr(Actual)), Expected = Actual,CallerAddr);
end; end;
class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: currency); class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: currency);
begin begin
AssertTrue(ComparisonMsg(AMessage,FloatToStr(Expected), FloatToStr(Actual)), Expected = Actual); AssertTrue(ComparisonMsg(AMessage,FloatToStr(Expected), FloatToStr(Actual)), Expected = Actual,CallerAddr);
end; end;
class procedure TAssert.AssertEquals(Expected, Actual: currency); class procedure TAssert.AssertEquals(Expected, Actual: currency);
begin begin
AssertEquals('', Expected, Actual); AssertTrue(ComparisonMsg(FloatToStr(Expected), FloatToStr(Actual)), Expected = Actual,CallerAddr);
end; end;
class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual, Delta: double); class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual, Delta: double);
begin begin
AssertTrue(ComparisonMsg(AMessage,FloatToStr(Expected),FloatToStr(Actual)), AssertTrue(ComparisonMsg(AMessage,FloatToStr(Expected),FloatToStr(Actual)),
(Abs(Expected - Actual) <= Delta)); (Abs(Expected - Actual) <= Delta),CallerAddr);
end; end;
class procedure TAssert.AssertEquals(Expected, Actual, Delta: double); class procedure TAssert.AssertEquals(Expected, Actual, Delta: double);
begin begin
AssertEquals('', Expected, Actual, Delta); AssertTrue(ComparisonMsg(FloatToStr(Expected),FloatToStr(Actual)),
(Abs(Expected - Actual) <= Delta),CallerAddr);
end; end;
class procedure TAssert.AssertNotNull(const AMessage, AString: string); class procedure TAssert.AssertNotNull(const AMessage, AString: string);
begin begin
AssertTrue(AMessage, AString <> ''); AssertTrue(AMessage, AString <> '',CallerAddr);
end; end;
class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: boolean); class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: boolean);
begin begin
AssertTrue(ComparisonMsg(AMessage,BoolToStr(Expected, true), BoolToStr(Actual, true)), Expected = Actual); AssertTrue(ComparisonMsg(AMessage,BoolToStr(Expected, true), BoolToStr(Actual, true)), Expected = Actual,CallerAddr);
end; end;
class procedure TAssert.AssertEquals(Expected, Actual: boolean); class procedure TAssert.AssertEquals(Expected, Actual: boolean);
begin begin
AssertEquals('', Expected, Actual); AssertTrue(ComparisonMsg(BoolToStr(Expected, true), BoolToStr(Actual, true)), Expected = Actual,CallerAddr);
end; end;
class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: char); class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: char);
begin begin
AssertTrue(ComparisonMsg(AMessage,Expected, Actual), Expected = Actual); AssertTrue(ComparisonMsg(AMessage,Expected, Actual), Expected = Actual,CallerAddr);
end; end;
class procedure TAssert.AssertEquals(Expected, Actual: char); class procedure TAssert.AssertEquals(Expected, Actual: char);
begin begin
AssertEquals('', Expected, Actual); AssertTrue(ComparisonMsg(Expected, Actual), Expected = Actual,CallerAddr);
end; end;
class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: TClass); class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: TClass);
Function GetN(C : TClass) : string;
begin
if C=Nil then
Result:='<NIL>'
else
Result:=C.ClassName;
end;
begin begin
AssertTrue(ComparisonMsg(AMessage,GetN(Expected), GetN(Actual)), Expected = Actual); AssertTrue(ComparisonMsg(AMessage,GetN(Expected), GetN(Actual)), Expected = Actual,CallerAddr);
end; end;
class procedure TAssert.AssertEquals(Expected, Actual: TClass); class procedure TAssert.AssertEquals(Expected, Actual: TClass);
begin begin
AssertEquals('', Expected, Actual); AssertTrue(ComparisonMsg(GetN(Expected), GetN(Actual)), Expected = Actual,CallerAddr);
end; end;
class procedure TAssert.AssertSame(const AMessage: string; Expected, Actual: TObject); class procedure TAssert.AssertSame(const AMessage: string; Expected, Actual: TObject);
begin begin
AssertTrue(ComparisonMsg(AMessage,IntToStr(PtrInt(Expected)), IntToStr(PtrInt(Actual))), AssertTrue(ComparisonMsg(AMessage,IntToStr(PtrInt(Expected)), IntToStr(PtrInt(Actual))), Expected = Actual,CallerAddr);
Expected = Actual);
end; end;
class procedure TAssert.AssertSame(Expected, Actual: TObject); class procedure TAssert.AssertSame(Expected, Actual: TObject);
begin begin
AssertSame('', Expected, Actual); AssertTrue(ComparisonMsg(IntToStr(PtrInt(Expected)), IntToStr(PtrInt(Actual))), Expected = Actual,CallerAddr);
end; end;
class procedure TAssert.AssertSame(const AMessage: string; Expected, Actual: Pointer); class procedure TAssert.AssertSame(const AMessage: string; Expected, Actual: Pointer);
begin begin
AssertTrue(ComparisonMsg(AMessage,IntToStr(PtrInt(Expected)), IntToStr(PtrInt(Actual))), AssertTrue(ComparisonMsg(AMessage,IntToStr(PtrInt(Expected)), IntToStr(PtrInt(Actual))), Expected = Actual,CallerAddr);
Expected = Actual);
end; end;
class procedure TAssert.AssertSame(Expected, Actual: Pointer); class procedure TAssert.AssertSame(Expected, Actual: Pointer);
begin begin
AssertSame('', Expected, Actual); AssertTrue(ComparisonMsg(IntToStr(PtrInt(Expected)), IntToStr(PtrInt(Actual))), Expected = Actual,CallerAddr);
end; end;
class procedure TAssert.AssertNotSame(const AMessage: string; Expected, Actual: TObject); class procedure TAssert.AssertNotSame(const AMessage: string; Expected, Actual: TObject);
begin begin
AssertFalse(SExpectedNotSame, Expected = Actual); AssertFalse('"' + aMessage + '"' + SExpectedNotSame, Expected = Actual,CallerAddr);
end; end;
class procedure TAssert.AssertNotSame(Expected, Actual: TObject); class procedure TAssert.AssertNotSame(Expected, Actual: TObject);
begin begin
AssertNotSame('', Expected, Actual); AssertFalse(SExpectedNotSame, Expected = Actual);
end; end;
class procedure TAssert.AssertNotSame(const AMessage: string; Expected, Actual: Pointer); class procedure TAssert.AssertNotSame(const AMessage: string; Expected, Actual: Pointer);
begin begin
AssertFalse(SExpectedNotSame, Expected = Actual); AssertFalse('"' + aMessage + '"' + SExpectedNotSame, Expected = Actual,CallerAddr);
end; end;
class procedure TAssert.AssertNotSame(Expected, Actual: Pointer); class procedure TAssert.AssertNotSame(Expected, Actual: Pointer);
begin begin
AssertNotSame('', Expected, Actual); AssertFalse(SExpectedNotSame, Expected = Actual,CallerAddr);
end; end;
class procedure TAssert.AssertNotNull(const AMessage: string; AObject: TObject); class procedure TAssert.AssertNotNull(const AMessage: string; AObject: TObject);
begin begin
AssertTrue(AMessage, (AObject <> nil)); AssertTrue(AMessage, (AObject <> nil),CallerAddr);
end; end;
class procedure TAssert.AssertNotNull(AObject: TObject); class procedure TAssert.AssertNotNull(AObject: TObject);
begin begin
AssertNotNull('', AObject); AssertTrue('',(AObject <> nil),CallerAddr);
end; end;
class procedure TAssert.AssertNotNullIntf(const AMessage: string; AInterface: IInterface); class procedure TAssert.AssertNotNullIntf(const AMessage: string; AInterface: IInterface);
begin begin
AssertTrue(AMessage, (AInterface <> nil)); AssertTrue(AMessage, (AInterface <> nil),CallerAddr);
end; end;
class procedure TAssert.AssertNotNullIntf(AInterface: IInterface); class procedure TAssert.AssertNotNullIntf(AInterface: IInterface);
begin begin
AssertNotNull('', AInterface); AssertTrue('', (AInterface <> nil),CallerAddr);
end; end;
class procedure TAssert.AssertNotNull(const AMessage: string; APointer: Pointer); class procedure TAssert.AssertNotNull(const AMessage: string; APointer: Pointer);
begin begin
AssertTrue(AMessage, (APointer <> nil)); AssertTrue(AMessage, (APointer <> nil),callerAddr);
end; end;
class procedure TAssert.AssertNotNull(APointer: Pointer); class procedure TAssert.AssertNotNull(APointer: Pointer);
begin begin
AssertNotNull('', APointer); AssertTrue('', (APointer <> nil),callerAddr);
end; end;
class procedure TAssert.AssertNull(const AMessage: string; AObject: TObject); class procedure TAssert.AssertNull(const AMessage: string; AObject: TObject);
begin begin
AssertTrue(AMessage, (AObject = nil)); AssertTrue(AMessage, (AObject = nil),CallerAddr);
end; end;
class procedure TAssert.AssertNull(AObject: TObject); class procedure TAssert.AssertNull(AObject: TObject);
begin begin
AssertNull('', AObject); AssertTrue('',(AObject = nil),CallerAddr);
end; end;
class procedure TAssert.AssertNullIntf(const AMessage: string; AInterface: IInterface); class procedure TAssert.AssertNullIntf(const AMessage: string; AInterface: IInterface);
begin begin
AssertTrue(AMessage, (AInterface = nil)); AssertTrue(AMessage, (AInterface = nil),CallerAddr);
end; end;
class procedure TAssert.AssertNullIntf(AInterface: IInterface); class procedure TAssert.AssertNullIntf(AInterface: IInterface);
begin begin
AssertNull('', AInterface); AssertTrue('', (AInterface = nil),CallerAddr);
end; end;
class procedure TAssert.AssertNull(const AMessage: string; APointer: Pointer); class procedure TAssert.AssertNull(const AMessage: string; APointer: Pointer);
begin begin
AssertTrue(AMessage, (APointer = nil)); AssertTrue(AMessage, (APointer = nil),CallerAddr);
end; end;
class procedure TAssert.AssertNull(APointer: Pointer); class procedure TAssert.AssertNull(APointer: Pointer);
begin begin
AssertNull('', APointer); AssertTrue('', (APointer = nil),CallerAddr);
end; end;
class procedure TAssert.AssertException(const AMessage: string; AExceptionClass: ExceptClass; class procedure TAssert.AssertException(const AMessage: string; AExceptionClass: ExceptClass;
AMethod: TRunMethod); AMethod: TRunMethod;AExceptionMessage : String = ''; AExceptionContext : Integer = 0; AErrorAddr : Pointer = Nil);
Function MisMatch (AClassName : String) : String;
begin
Result:=Format(SExceptionCompare,[AExceptionClass.ClassName, AClassName])
end;
var var
Passed : Boolean; FailMsg : string;
ExceptionName: string;
begin begin
Passed := False; If AErrorAddr=Nil then
AErrorAddr:=CallerAddr;
FailMsg:='';
try try
AMethod; AMethod;
ExceptionName:=SNoException; FailMsg:=MisMatch(SNoException);
except except
on E: Exception do on E: Exception do
begin
ExceptionName := E.ClassName;
if E.ClassType.InheritsFrom(AExceptionClass) then
begin begin
Passed := AExceptionClass.ClassName = E.ClassName; if Not E.ClassType.InheritsFrom(AExceptionClass) then
FailMsg:=MisMatch(E.ClassName)
else if not (AExceptionClass.ClassName = E.ClassName) then
FailMsg:=MisMatch(E.ClassName)
else if (AExceptionMessage<>'') and (AExceptionMessage<>E.Message) then
FailMsg:=ComparisonMsg(SExceptionMessageCompare,AExceptionMessage,E.Message)
else if (AExceptionContext<>0) and (AExceptionContext<>E.HelpContext) then
FailMsg:=ComparisonMsg(SExceptionHelpContextCompare,IntToStr(AExceptionContext),IntToStr(E.HelpContext))
end; end;
end;
end; end;
AssertTrue(Format(SExceptionCompare, [AExceptionClass.ClassName, ExceptionName])+ ': ' + AMessage, Passed); AssertTrue(AMessage + FailMsg, FailMsg='', AErrorAddr);
end; end;
class procedure TAssert.AssertException(AExceptionClass: ExceptClass; class procedure TAssert.AssertException(AExceptionClass: ExceptClass;
AMethod: TRunMethod); AMethod: TRunMethod;AExceptionMessage : String = ''; AExceptionContext : Integer = 0);
begin begin
AssertException('', AExceptionClass, AMethod); AssertException('', AExceptionClass, AMethod,'',0,CallerAddr);
end; end;
@ -1019,7 +1036,7 @@ begin
begin begin
if (FExpectedExceptionFailMessage<>'') then if (FExpectedExceptionFailMessage<>'') then
FailMessage:=' : '+FailMessage; FailMessage:=' : '+FailMessage;
Fail(FExpectedExceptionFailMessage+FailMessage); Fail(FExpectedExceptionFailMessage+FailMessage,FExpectedExceptionCaller);
end; end;
end end
else else
@ -1179,12 +1196,17 @@ begin
FExpectedException:=AExceptionClass; FExpectedException:=AExceptionClass;
FExpectedExceptionMessage:=AExceptionMessage; FExpectedExceptionMessage:=AExceptionMessage;
FExpectedExceptionContext:=AExceptionHelpContext; FExpectedExceptionContext:=AExceptionHelpContext;
FExpectedExceptionCaller:=CallerAddr;
end; end;
procedure TTestCase.ExpectException(AExceptionClass: TClass; procedure TTestCase.ExpectException(AExceptionClass: TClass;
AExceptionMessage: string = ''; AExceptionHelpContext: Integer = 0); AExceptionMessage: string = ''; AExceptionHelpContext: Integer = 0);
begin begin
ExpectException('',AExceptionClass,AExceptionMessage,AExceptionHelpContext); FExpectedExceptionFailMessage:='';
FExpectedException:=AExceptionClass;
FExpectedExceptionMessage:=AExceptionMessage;
FExpectedExceptionContext:=AExceptionHelpContext;
FExpectedExceptionCaller:=CallerAddr;
end; end;
procedure TTestSuite.Run(AResult: TTestResult); procedure TTestSuite.Run(AResult: TTestResult);