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

* Patch from Graeme Geldenhuys: Some helper functions

Browse Source 
git-svn-id: trunk@30311 -
This commit is contained in:
michael 2015-03-24 13:31:10 +00:00
parent d540c77660
commit 8ee96289fc
1 changed files with 32 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -295,6 +295,9 @@ type
function ComparisonMsg(const aExpected: UnicodeString; const aActual: UnicodeString; const aCheckEqual: boolean=true): string; overload; function ComparisonMsg(const aExpected: UnicodeString; const aActual: UnicodeString; const aCheckEqual: boolean=true): string; overload;
{$ENDIF} {$ENDIF}
// Made public for 3rd party developers extending TTestCase with new AssertXXX methods
function CallerAddr: Pointer;
Resourcestring Resourcestring
@ -323,6 +326,35 @@ Const
{$define read_implementation} {$define read_implementation}
function CallerAddr: Pointer;
var
bp: Pointer;
begin
bp := get_caller_frame(get_frame);
if bp <> nil then
Result := get_caller_addr(bp)
else
Result := nil;
end;
function AddrsToStr(Addrs: Pointer): string;
begin
if PtrUInt(Addrs) > 0 then
Result := '$'+Format('%p', [Addrs])
else
Result := 'n/a';
end;
function PointerToLocationInfo(Addrs: Pointer): string;
begin
Result := BackTraceStrFunc(Addrs);
if Trim(Result) = '' then
Result := AddrsToStr(Addrs) + ' <no map file>';
end;
type type
TTestWarning = class(TTestCase) TTestWarning = class(TTestCase)