summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authornijtmans <nijtmans>2010-12-16 08:52:37 (GMT)
committernijtmans <nijtmans>2010-12-16 08:52:37 (GMT)
commitea1de9848ccde7951194b1ed58065ee6b43f7c66 (patch)
treef6a3b71a40be33da4256477fb25da8e2573b127e
parent8802a351978129fb686ef18982430a0c366fb06a (diff)
downloadtcl-ea1de9848ccde7951194b1ed58065ee6b43f7c66.zip
tcl-ea1de9848ccde7951194b1ed58065ee6b43f7c66.tar.gz
tcl-ea1de9848ccde7951194b1ed58065ee6b43f7c66.tar.bz2
[Patch 3124554]: Move WishPanic from Tk to Tcl
Better communication with debugger, if present.
-rw-r--r--ChangeLog7
-rw-r--r--generic/tclPanic.c25
-rw-r--r--win/tclWinFile.c26
3 files changed, 42 insertions, 16 deletions
diff --git a/ChangeLog b/ChangeLog
index bb01061..b6f04b4 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,4 +1,9 @@
-2010-12-14 Jan Nijtmans <nijtmans@users.sf.net>
+2010-12-16 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclPanic.c: [Patch 3124554]: Move WishPanic from Tk to Tcl
+ * win/tclWinFile.c: Better communication with debugger, if present.
+
+2010-12-15 Jan Nijtmans <nijtmans@users.sf.net>
* generic/tclPanic.c: Restore abort() as it was before.
* win/tclWinFile.c: [Patch 3124554] use ExitProcess() here, like
diff --git a/generic/tclPanic.c b/generic/tclPanic.c
index d5d6142..6ef39e1 100644
--- a/generic/tclPanic.c
+++ b/generic/tclPanic.c
@@ -12,10 +12,16 @@
* 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.17 2010/12/15 14:03:52 nijtmans Exp $
+ * RCS: @(#) $Id: tclPanic.c,v 1.18 2010/12/16 08:52:37 nijtmans Exp $
*/
#include "tclInt.h"
+#ifdef _WIN32
+# ifdef _MSC_VER
+# include <intrin.h>
+# endif
+ MODULE_SCOPE void tclWinDebugPanic(const char *format, ...);
+#endif
/*
* The panicProc variable contains a pointer to an application specific panic
@@ -44,6 +50,10 @@ void
Tcl_SetPanicProc(
Tcl_PanicProc *proc)
{
+#ifdef _WIN32
+ /* tclWinDebugPanic only installs if there is no panicProc yet. */
+ if ((proc != tclWinDebugPanic) || (panicProc == NULL))
+#endif
panicProc = proc;
}
@@ -84,6 +94,10 @@ Tcl_PanicVA(
if (panicProc != NULL) {
panicProc(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
+#ifdef _WIN32
+ } else if (IsDebuggerPresent()) {
+ tclWinDebugPanic(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
+#endif
} else {
fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6, arg7,
arg8);
@@ -91,7 +105,16 @@ Tcl_PanicVA(
fflush(stderr);
}
/* In case the users panic proc does not abort, we do it here */
+#ifdef _WIN32
+# ifdef __GNUC__
+ __builtin_trap();
+# elif _MSC_VER
+ __debugbreak();
+# endif
+ ExitProcess(1);
+#else
abort();
+#endif
}
/*
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 48ce2d0..1e1fe90 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.118 2010/12/15 14:03:52 nijtmans Exp $
+ * RCS: @(#) $Id: tclWinFile.c,v 1.119 2010/12/16 08:52:37 nijtmans Exp $
*/
#include "tclWinInt.h"
@@ -175,6 +175,7 @@ static int WinLink(const TCHAR *LinkSource,
const TCHAR *LinkTarget, int linkAction);
static int WinSymLinkDirectory(const TCHAR *LinkDirectory,
const TCHAR *LinkTarget);
+MODULE_SCOPE void tclWinDebugPanic(const char *format, ...);
/*
*--------------------------------------------------------------------
@@ -786,9 +787,10 @@ NativeWriteReparse(
/*
*----------------------------------------------------------------------
*
- * WishPanic --
+ * tclWinDebugPanic --
*
- * Display a message.
+ * Display a message. If a debugger is present, present it directly
+ * to the debugger, otherwise use a MessageBox.
*
* Results:
* None.
@@ -799,8 +801,8 @@ NativeWriteReparse(
*----------------------------------------------------------------------
*/
-static void
-PanicMessageBox(
+void
+tclWinDebugPanic(
const char *format, ...)
{
#define TCL_MAX_WARN_LEN 1024
@@ -820,17 +822,13 @@ PanicMessageBox(
if (msgString[TCL_MAX_WARN_LEN-1] != L'\0') {
memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR));
}
+ if (IsDebuggerPresent()) {
+ OutputDebugStringW(msgString);
+ } else {
MessageBeep(MB_ICONEXCLAMATION);
MessageBoxW(NULL, msgString, L"Fatal Error",
MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
- /* try to trigger the debugger */
-# ifdef __GNUC__
- __builtin_trap();
-# endif
-# ifdef _MSC_VER
- DebugBreak();
-# endif
- ExitProcess(1);
+ }
}
/*
@@ -862,7 +860,7 @@ TclpFindExecutable(
* create this process. Only if it is NULL, install a new panic handler.
*/
if (argv0 == NULL) {
- Tcl_SetPanicProc(PanicMessageBox);
+ Tcl_SetPanicProc(tclWinDebugPanic);
}
#ifdef UNICODE