rebase TIP [http://tip.tcl.tk/425|425] implementation

11 files changed, 149 insertions, 9 deletions

diff --git a/doc/Panic.3 b/doc/Panic.3
index 48aed2b..9013e89 100644
--- a/doc/Panic.3
+++ b/doc/Panic.3
@@ -7,7 +7,7 @@
 .BS
 '\"  Note:  do not modify the .SH NAME line immediately below!
 .SH NAME
-Tcl_Panic, Tcl_PanicVA, Tcl_SetPanicProc \- report fatal error and abort
+Tcl_Panic, Tcl_PanicVA, Tcl_SetPanicProc, Tcl_ConsolePanic \- report fatal error and abort
 .SH SYNOPSIS
 .nf
 \fB#include <tcl.h>\fR
@@ -21,6 +21,9 @@ void
 void
 \fBTcl_SetPanicProc\fR(\fIpanicProc\fR)
 .sp
+void
+\fBTcl_ConsolePanic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR)
+.sp
 .SH ARGUMENTS
 .AS Tcl_PanicProc *panicProc
 .AP "const char*" format in
@@ -54,6 +57,14 @@ message is sent to the debugger in stead. If the windows executable
 does not have a stderr channel (e.g. \fBwish.exe\fR), then a
 system dialog box is used to display the panic message.
 .PP
+If your application doesn't use \fBTcl_Main\fR or \fBTk_Main\fR
+and you want to implicitly use the stderr channel of your
+application's C runtime (in stead of the stderr channel of the
+C runtime used by Tcl), you can call \fBTcl_SetPanicProc\fR
+with \fBTcl_ConsolePanic\fR as its argument. On platforms which
+only have one C runtime (almost all platforms except Windows
+and Cygwin) \fBTcl_ConsolePanic\fR is equivalent to NULL.
+.PP
 \fBTcl_SetPanicProc\fR may be used to modify the behavior of
 \fBTcl_Panic\fR.  The \fIpanicProc\fR argument should match the
 type \fBTcl_PanicProc\fR:
diff --git a/generic/tcl.h b/generic/tcl.h
index a833218..848b5d0 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2397,6 +2397,11 @@ const char *		Tcl_InitStubs(Tcl_Interp *interp, const char *version,
 			    int exact);
 const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
 			    const char *version, int epoch, int revision);
+#if defined(_WIN32) || defined(__CYGWIN__)
+    void Tcl_ConsolePanic(const char *format, ...);
+#else
+#   define Tcl_ConsolePanic ((Tcl_PanicProc *)0)
+#endif
 
 /*
  * When not using stubs, make it a macro.
@@ -2417,7 +2422,7 @@ const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
  */
 
 #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
-	    ((Tcl_CreateInterp)()))
+	    ((Tcl_SetPanicProc(Tcl_ConsolePanic), Tcl_CreateInterp)()))
 EXTERN void		Tcl_MainEx(int argc, char **argv,
 			    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
 EXTERN const char *	Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 686b80d..941d566 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -1171,8 +1171,6 @@ Tcl_Finalize(void)
 
     TclFinalizeEncodingSubsystem();
 
-    Tcl_SetPanicProc(NULL);
-
     /*
      * Repeat finalization of the thread local storage once more. Although
      * this step is already done by the Tcl_FinalizeThread call above, series
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 443e70d..1df2186 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -338,6 +338,7 @@ TOMMATH_OBJS = bncore.o bn_reverse.o bn_fast_s_mp_mul_digs.o \
 STUB_LIB_OBJS = tclStubLib.o \
 	tclTomMathStubLib.o \
 	tclOOStubLib.o \
+	@STUB_OBJS@ \
 	${COMPAT_OBJS}
 
 UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \
@@ -1588,10 +1589,13 @@ tclMacOSXFCmd.o: $(MAC_OSX_DIR)/tclMacOSXFCmd.c
 tclMacOSXNotify.o: $(MAC_OSX_DIR)/tclMacOSXNotify.c
 	$(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tclMacOSXNotify.c
 
-# The following is a CYGWIN only source:
+# The following are CYGWIN only sources:
 tclWinError.o: $(TOP_DIR)/win/tclWinError.c
 	$(CC) -c $(CC_SWITCHES) $(TOP_DIR)/win/tclWinError.c
 
+tclWinPanic.o: $(TOP_DIR)/win/tclWinPanic.c
+	$(CC) -c $(CC_SWITCHES) -DBUILD_STATIC $(TOP_DIR)/win/tclWinPanic.c
+
 # DTrace support
 
 $(TCL_OBJS) $(STUB_LIB_OBJS) $(TCLSH_OBJS) $(TCLTEST_OBJS) $(XTTEST_OBJS): @DTRACE_HDR@
diff --git a/unix/configure b/unix/configure
index 9b3c298..9ce505f 100755
--- a/unix/configure
+++ b/unix/configure
@@ -308,7 +308,7 @@ ac_includes_default="\
 # include <unistd.h>
 #endif"
 
-ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAN_FLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP TCL_THREADS TCLSH_PROG ZLIB_OBJS ZLIB_SRCS ZLIB_INCLUDE RANLIB ac_ct_RANLIB AR ac_ct_AR LIBOBJS TCL_LIBS DL_LIBS DL_OBJS PLAT_OBJS PLAT_SRCS LDAIX_SRC CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING LDFLAGS_DEBUG LDFLAGS_OPTIMIZE CC_SEARCH_FLAGS LD_SEARCH_FLAGS STLIB_LD SHLIB_LD TCL_SHLIB_LD_EXTRAS TK_SHLIB_LD_EXTRAS SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX MAKE_LIB MAKE_STUB_LIB INSTALL_LIB DLL_INSTALL_DIR INSTALL_STUB_LIB CFLAGS_DEFAULT LDFLAGS_DEFAULT DTRACE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_YEAR PKG_CFG_ARGS TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_SRC_DIR CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX TCL_SHARED_BUILD LD_LIBRARY_PATH_VAR TCL_BUILD_LIB_SPEC TCL_LIB_VERSIONS_OK TCL_SHARED_LIB_SUFFIX TCL_UNSHARED_LIB_SUFFIX TCL_HAS_LONGLONG INSTALL_TZDATA DTRACE_SRC DTRACE_HDR DTRACE_OBJ MAKEFILE_SHELL BUILD_DLTEST TCL_PACKAGE_PATH TCL_MODULE_PATH TCL_LIBRARY PRIVATE_INCLUDE_DIR HTML_DIR PACKAGE_DIR EXTRA_CC_SWITCHES EXTRA_APP_CC_SWITCHES EXTRA_INSTALL EXTRA_INSTALL_BINARIES EXTRA_BUILD_HTML EXTRA_TCLSH_LIBS DLTEST_LD DLTEST_SUFFIX'
+ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAN_FLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP TCL_THREADS TCLSH_PROG ZLIB_OBJS ZLIB_SRCS ZLIB_INCLUDE RANLIB ac_ct_RANLIB AR ac_ct_AR LIBOBJS TCL_LIBS DL_LIBS DL_OBJS PLAT_OBJS PLAT_SRCS STUB_OBJS LDAIX_SRC CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING LDFLAGS_DEBUG LDFLAGS_OPTIMIZE CC_SEARCH_FLAGS LD_SEARCH_FLAGS STLIB_LD SHLIB_LD TCL_SHLIB_LD_EXTRAS TK_SHLIB_LD_EXTRAS SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX MAKE_LIB MAKE_STUB_LIB INSTALL_LIB DLL_INSTALL_DIR INSTALL_STUB_LIB CFLAGS_DEFAULT LDFLAGS_DEFAULT DTRACE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_YEAR PKG_CFG_ARGS TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_SRC_DIR CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX TCL_SHARED_BUILD LD_LIBRARY_PATH_VAR TCL_BUILD_LIB_SPEC TCL_LIB_VERSIONS_OK TCL_SHARED_LIB_SUFFIX TCL_UNSHARED_LIB_SUFFIX TCL_HAS_LONGLONG INSTALL_TZDATA DTRACE_SRC DTRACE_HDR DTRACE_OBJ MAKEFILE_SHELL BUILD_DLTEST TCL_PACKAGE_PATH TCL_MODULE_PATH TCL_LIBRARY PRIVATE_INCLUDE_DIR HTML_DIR PACKAGE_DIR EXTRA_CC_SWITCHES EXTRA_APP_CC_SWITCHES EXTRA_INSTALL EXTRA_INSTALL_BINARIES EXTRA_BUILD_HTML EXTRA_TCLSH_LIBS DLTEST_LD DLTEST_SUFFIX'
 ac_subst_files=''
 
 # Initialize some variables set by options.
@@ -6872,6 +6872,7 @@ fi
     LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH"
     PLAT_OBJS=""
     PLAT_SRCS=""
+    STUB_OBJS=""
     LDAIX_SRC=""
     if test x"${SHLIB_VERSION}" = x; then
   SHLIB_VERSION="1.0"
@@ -7076,6 +7077,7 @@ fi
 	    DL_OBJS="tclLoadDl.o"
 	    PLAT_OBJS='${CYGWIN_OBJS}'
 	    PLAT_SRCS='${CYGWIN_SRCS}'
+	    STUB_OBJS="tclWinPanic.o"
 	    DL_LIBS="-ldl"
 	    CC_SEARCH_FLAGS=""
 	    LD_SEARCH_FLAGS=""
@@ -9198,6 +9200,7 @@ _ACEOF
 
 
 
+
 cat >>confdefs.h <<_ACEOF
 #define TCL_SHLIB_EXT "${SHLIB_SUFFIX}"
 _ACEOF
@@ -20023,6 +20026,7 @@ s,@DL_LIBS@,$DL_LIBS,;t t
 s,@DL_OBJS@,$DL_OBJS,;t t
 s,@PLAT_OBJS@,$PLAT_OBJS,;t t
 s,@PLAT_SRCS@,$PLAT_SRCS,;t t
+s,@STUB_OBJS@,$STUB_OBJS,;t t
 s,@LDAIX_SRC@,$LDAIX_SRC,;t t
 s,@CFLAGS_DEBUG@,$CFLAGS_DEBUG,;t t
 s,@CFLAGS_OPTIMIZE@,$CFLAGS_OPTIMIZE,;t t
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index 194cf90..b753d5b 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -1125,6 +1125,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
     LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH"
     PLAT_OBJS=""
     PLAT_SRCS=""
+    STUB_OBJS=""
     LDAIX_SRC=""
     AS_IF([test x"${SHLIB_VERSION}" = x], [SHLIB_VERSION="1.0"])
     case $system in
@@ -1231,6 +1232,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
 	    DL_OBJS="tclLoadDl.o"
 	    PLAT_OBJS='${CYGWIN_OBJS}'
 	    PLAT_SRCS='${CYGWIN_SRCS}'
+	    STUB_OBJS="tclWinPanic.o"
 	    DL_LIBS="-ldl"
 	    CC_SEARCH_FLAGS=""
 	    LD_SEARCH_FLAGS=""
@@ -2112,6 +2114,7 @@ dnl # preprocessing tests use only CPPFLAGS.
     AC_SUBST(DL_OBJS)
     AC_SUBST(PLAT_OBJS)
     AC_SUBST(PLAT_SRCS)
+    AC_SUBST(STUB_OBJS)
     AC_SUBST(LDAIX_SRC)
     AC_SUBST(CFLAGS)
     AC_SUBST(CFLAGS_DEBUG)
diff --git a/win/Makefile.in b/win/Makefile.in
index 47f3fdd..8f66288 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -386,7 +386,8 @@ REG_OBJS = tclWinReg.$(OBJEXT)
 STUB_OBJS = \
 	tclStubLib.$(OBJEXT) \
 	tclTomMathStubLib.$(OBJEXT) \
-	tclOOStubLib.$(OBJEXT)
+	tclOOStubLib.$(OBJEXT) \
+	tclWinPanic.$(OBJEXT)
 
 TCLSH_OBJS = tclAppInit.$(OBJEXT)
 
@@ -521,6 +522,9 @@ tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c
 tclOOStubLib.${OBJEXT}: tclOOStubLib.c
 	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
 
+tclWinPanic.${OBJEXT}: tclWinPanic.c
+	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
+
 # Implicit rule for all object files that will end up in the Tcl library
 
 %.${OBJEXT}: %.c
diff --git a/win/makefile.bc b/win/makefile.bc
index 0b17cea..4d97d85 100644
--- a/win/makefile.bc
+++ b/win/makefile.bc
@@ -280,7 +280,8 @@ TCLOBJS	= \
 TCLSTUBOBJS	= \
 	$(TMPDIR)\tclStubLib.obj \
 	$(TMPDIR)\tclTomMathStubLib.obj \
-	$(TMPDIR)\tclOOStubLib.obj
+	$(TMPDIR)\tclOOStubLib.obj \
+	$(TMPDIR)\tclWinPanic.obj
 
 WINDIR		= $(ROOT)\win
 GENERICDIR	= $(ROOT)\generic
@@ -534,6 +535,9 @@ $(TMPDIR)\tclTomMathStubLib.obj : $(GENERICDIR)\tclTomMathStubLib.c
 $(TMPDIR)\tclOOStubLib.obj : $(GENERICDIR)\tclOOStubLib.c
 	$(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $?
 
+$(TMPDIR)\tclWinPanic.obj : $(WINDIR)\tclWinPanic.c
+	$(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $?
+
 
 # Dedependency rules
 
diff --git a/win/makefile.vc b/win/makefile.vc
index cddb253..2f3d8fb 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -451,7 +451,8 @@ TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS)
 TCLSTUBOBJS = \
 	$(TMP_DIR)\tclStubLib.obj \
 	$(TMP_DIR)\tclTomMathStubLib.obj \
-	$(TMP_DIR)\tclOOStubLib.obj
+	$(TMP_DIR)\tclOOStubLib.obj \
+	$(TMP_DIR)\tclWinPanic.obj
 
 ### The following paths CANNOT have spaces in them.
 COMPATDIR	= $(ROOT)\compat
@@ -985,6 +986,9 @@ $(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c
 $(TMP_DIR)\tclOOStubLib.obj: $(GENERICDIR)\tclOOStubLib.c
 	$(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
 
+$(TMP_DIR)\tclWinPanic.obj: $(WINDIR)\tclWinPanic.c
+	$(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
+
 #---------------------------------------------------------------------
 # Generate the source dependencies.  Having dependency rules will
 # improve incremental build accuracy without having to resort to a
diff --git a/win/tcl.dsp b/win/tcl.dsp
index 57ec6bf..5880d09 100644
--- a/win/tcl.dsp
+++ b/win/tcl.dsp
@@ -1304,6 +1304,10 @@ SOURCE=..\generic\tclOOStubLib.c
 # End Source File
 # Begin Source File
 
+SOURCE=..\generic\tclWinPanic.c
+# End Source File
+# Begin Source File
+
 SOURCE=..\generic\tclTomMathStubLib.c
 # End Source File
 # Begin Source File
diff --git a/win/tclWinPanic.c b/win/tclWinPanic.c
new file mode 100644
index 0000000..3c2e072
--- /dev/null
+++ b/win/tclWinPanic.c
@@ -0,0 +1,99 @@
+/*
+ * tclWinPanic.c --
+ *
+ *	Contains the Windows-specific command-line panic proc.
+ *
+ * Copyright (c) 2013 by Jan Nijtmans.
+ * All rights reserved.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tclInt.h"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ConsolePanic --
+ *
+ *	Display a message. If a debugger is present, present it directly to
+ *	the debugger, otherwise send it to stderr.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ConsolePanic(
+    const char *format, ...)
+{
+#define TCL_MAX_WARN_LEN 26000
+    va_list argList;
+    WCHAR msgString[TCL_MAX_WARN_LEN];
+    char buf[TCL_MAX_WARN_LEN * TCL_UTF_MAX];
+#ifndef __CYGWIN__
+    HANDLE handle = GetStdHandle(STD_ERROR_HANDLE);
+    DWORD dummy;
+#endif
+
+    va_start(argList, format);
+    vsnprintf(buf+3, sizeof(buf)-3, format, argList);
+    buf[sizeof(buf)-1] = 0;
+    msgString[TCL_MAX_WARN_LEN-1] = L'\0';
+    MultiByteToWideChar(CP_UTF8, 0, buf+3, -1, msgString, TCL_MAX_WARN_LEN);
+
+    /*
+     * Truncate MessageBox string if it is too long to not overflow the buffer.
+     */
+
+    if (msgString[TCL_MAX_WARN_LEN-1] != L'\0') {
+	memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR));
+    }
+
+    if (IsDebuggerPresent()) {
+	OutputDebugStringW(msgString);
+#ifdef __CYGWIN__
+    } else {
+	buf[0] = 0xEF; buf[1] = 0xBB; buf[2] = 0xBF; /* UTF-8 bom */
+	write(2, buf, strlen(buf));
+	fsync(2);
+#else
+    } else if (_isatty(2)) {
+	WriteConsoleW(handle, msgString, wcslen(msgString), &dummy, 0);
+    } else {
+	buf[0] = 0xEF; buf[1] = 0xBB; buf[2] = 0xBF; /* UTF-8 bom */
+	WriteFile(handle, buf, strlen(buf), &dummy, 0);
+	FlushFileBuffers(handle);
+#endif
+    }
+#if defined(_WIN32) || defined(__CYGWIN__)
+#   if defined(__GNUC__)
+	__builtin_trap();
+#   elif defined(_WIN64)
+	__debugbreak();
+#   elif defined(_MSC_VER)
+	_asm {int 3}
+#   else
+	DebugBreak();
+#   endif
+#endif
+#if defined(_WIN32)
+	ExitProcess(1);
+#else
+	abort();
+#endif
+}
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * tab-width: 8
+ * End:
+ */