diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | generic/tclPanic.c | 25 | ||||
| -rw-r--r-- | win/tclWinFile.c | 26 |
3 files changed, 42 insertions, 16 deletions
@@ -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 |