summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authornijtmans <nijtmans>2010-12-13 13:57:58 (GMT)
committernijtmans <nijtmans>2010-12-13 13:57:58 (GMT)
commitb8aefcc068ba0ea1d0259b9321757135e1315167 (patch)
tree30ca1b28ea6a5faf5f439edcb9d87fb9e08fef81
parent15b3fd3efd468b197e322191cb62d25baf556ab0 (diff)
downloadtcl-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--ChangeLog7
-rw-r--r--generic/tclPanic.c14
-rw-r--r--win/tclWinFile.c53
3 files changed, 66 insertions, 8 deletions
diff --git a/ChangeLog b/ChangeLog
index 054fd00..b943834 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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);