diff options
author | nijtmans <nijtmans> | 2010-12-13 13:57:58 (GMT) |
---|---|---|
committer | nijtmans <nijtmans> | 2010-12-13 13:57:58 (GMT) |
commit | b8aefcc068ba0ea1d0259b9321757135e1315167 (patch) | |
tree | 30ca1b28ea6a5faf5f439edcb9d87fb9e08fef81 | |
parent | 15b3fd3efd468b197e322191cb62d25baf556ab0 (diff) | |
download | tcl-b8aefcc068ba0ea1d0259b9321757135e1315167.zip tcl-b8aefcc068ba0ea1d0259b9321757135e1315167.tar.gz tcl-b8aefcc068ba0ea1d0259b9321757135e1315167.tar.bz2 |
Use gcc's __builtin_trap(), when available, to enter the debugger after a panic.
Undocumented feature, see [Patch 3124554]: Move WishPanic from Tk to Tcl.
-rw-r--r-- | ChangeLog | 7 | ||||
-rw-r--r-- | generic/tclPanic.c | 14 | ||||
-rw-r--r-- | win/tclWinFile.c | 53 |
3 files changed, 66 insertions, 8 deletions
@@ -1,3 +1,10 @@ +2010-12-13 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tclPanic.c: Use gcc's __builtin_trap(), when available, + to enter the debugger after a panic. + * win/tclWinFile.c: Undocumented feature, only meant to be + used by Tk_Main. See [Patch 3124554]: Move WishPanic from Tk to Tcl + 2010-12-12 Stuart Cassoff <stwo@users.sourceforge.net> * unix/tcl.m4: Better building on OpenBSD. diff --git a/generic/tclPanic.c b/generic/tclPanic.c index 9aa0627..73059a0 100644 --- a/generic/tclPanic.c +++ b/generic/tclPanic.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclPanic.c,v 1.15 2010/12/01 10:43:36 nijtmans Exp $ + * RCS: @(#) $Id: tclPanic.c,v 1.16 2010/12/13 13:57:58 nijtmans Exp $ */ #include "tclInt.h" @@ -90,13 +90,19 @@ Tcl_PanicVA( arg8); fprintf(stderr, "\n"); fflush(stderr); + } + /* In case the users panic proc does not abort, we do it here */ +#ifdef __GNUC__ + __builtin_trap(); +#endif #ifdef _WIN32 - DebugBreak(); +# ifdef _MSC_VER + DebugBreak(); +# endif ExitProcess(1); #else - abort(); + abort(); #endif - } } /* diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 6ef6f8c..0cd5f94 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinFile.c,v 1.116 2010/11/03 12:09:23 nijtmans Exp $ + * RCS: @(#) $Id: tclWinFile.c,v 1.117 2010/12/13 13:57:58 nijtmans Exp $ */ #include "tclWinInt.h" @@ -784,6 +784,49 @@ NativeWriteReparse( } /* + *---------------------------------------------------------------------- + * + * WishPanic -- + * + * Display a message. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +PanicMessageBox( + const char *format, ...) +{ +#define TCL_MAX_WARN_LEN 1024 + va_list argList; + char buf[TCL_MAX_WARN_LEN * TCL_UTF_MAX]; + WCHAR msgString[TCL_MAX_WARN_LEN]; + + va_start(argList, format); + vsnprintf(buf, sizeof(buf), format, argList); + + msgString[TCL_MAX_WARN_LEN-1] = L'\0'; + MultiByteToWideChar(CP_UTF8, 0, buf, -1, msgString, TCL_MAX_WARN_LEN); + /* + * Truncate MessageBox string if it is too long to not overflow the screen + * and cause possible oversized window error. + */ + if (msgString[TCL_MAX_WARN_LEN-1] != L'\0') { + memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR)); + } + MessageBeep(MB_ICONEXCLAMATION); + MessageBoxW(NULL, msgString, L"Fatal Error", + MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND); + /* We don't need to abort here, because our caller already does. */ +} + +/* *--------------------------------------------------------------------------- * * TclpFindExecutable -- @@ -802,16 +845,18 @@ NativeWriteReparse( void TclpFindExecutable( - const char *argv0) /* The value of the application's argv[0] - * (native). */ + const char *argv0) /* If NULL, install PanicMessageBox, otherwise ignore */ { WCHAR wName[MAX_PATH]; char name[MAX_PATH * TCL_UTF_MAX]; /* * Under Windows we ignore argv0, and return the path for the file used to - * create this process. + * create this process. Only if it is NULL, install a new panic handler. */ + if (argv0 == NULL) { + Tcl_SetPanicProc(PanicMessageBox); + } #ifdef UNICODE GetModuleFileNameW(NULL, wName, MAX_PATH); |