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

* only print exception backtrace at end of unhandled exception in

Browse Source 
tthread in case rtl is compiled with -dDEBUG_MT

git-svn-id: trunk@8595 -
This commit is contained in:
Jonas Maebe 2007-09-21 15:09:08 +00:00
parent 956d5e1c91
commit 4e78a30ee3
1 changed files with 4 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
rtl/unix/tthread.inc
View File

@ -85,7 +85,9 @@ end;
function ThreadFunc(parameter: Pointer): ptrint; function ThreadFunc(parameter: Pointer): ptrint;
var var
LThread: TThread; LThread: TThread;
{$ifdef DEBUG_MT}
lErrorAddr, lErrorBase: Pointer; lErrorAddr, lErrorBase: Pointer;
{$endif}
begin begin
WRITE_DEBUG('ThreadFunc is here...'); WRITE_DEBUG('ThreadFunc is here...');
LThread := TThread(parameter); LThread := TThread(parameter);
@ -123,6 +125,7 @@ begin
except except
on e: exception do begin on e: exception do begin
LThread.FFatalException := TObject(AcquireExceptionObject); LThread.FFatalException := TObject(AcquireExceptionObject);
{$ifdef DEBUG_MT}
lErrorAddr:=ExceptAddr; lErrorAddr:=ExceptAddr;
lErrorBase:=ExceptFrames^; lErrorBase:=ExceptFrames^;
writeln(stderr,'Exception caught in thread $',hexstr(LThread), writeln(stderr,'Exception caught in thread $',hexstr(LThread),
@ -130,6 +133,7 @@ begin
writeln(stderr,BackTraceStrFunc(lErrorAddr)); writeln(stderr,BackTraceStrFunc(lErrorAddr));
dump_stack(stderr,lErrorBase); dump_stack(stderr,lErrorBase);
writeln(stderr); writeln(stderr);
{$endif}
// not sure if we should really do this... // not sure if we should really do this...
// but .Destroy was called, so why not try FreeOnTerminate? // but .Destroy was called, so why not try FreeOnTerminate?
if e is EThreadDestroyCalled then LThread.FFreeOnTerminate := true; if e is EThreadDestroyCalled then LThread.FFreeOnTerminate := true;