Tcl Source Code

Check-in [e2d9683a48]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:TIP #425 implementation: Correct use of UTF-8 in Panic Callback (Windows only)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-branch
Files: files | file ages | folders
SHA3-256: e2d9683a482fc92adeeb1c384e002e91752e8a7c3bbc51d3cbe3aef5ecce6ab0
User & Date: jan.nijtmans 2018-05-11 09:42:08
Context
2018-05-11
17:26
Missing test file boilerplate. check-in: 743007c3cc user: dgp tags: core-8-branch
11:52
merge 8.7 check-in: 78ab648e4f user: dgp tags: bug-e593adf103-core-8
11:51
merge 8.7 check-in: ccb831a772 user: dgp tags: core_zip_vfs
11:44
merge 8.7 check-in: 4e888b608e user: dgp tags: tip-469
11:38
merge 8.7 check-in: ccf912ef15 user: dgp tags: tip-465
11:35
merge 8.7 check-in: 78b076cb46 user: dgp tags: tip-312
11:33
merge 8.7 check-in: 2da5d7183f user: dgp tags: tip-505
11:30
merge 8.7 check-in: 6733cec87a user: dgp tags: dgp-string-insert
11:26
merge 8.7 check-in: 5dd49e9ab7 user: dgp tags: tip-445
11:26
merge 8.7 check-in: 97fa4939ba user: dgp tags: tip-502
10:06
Merge 8.7 check-in: f1b73e3b4b user: jan.nijtmans tags: trunk
09:42
TIP #425 implementation: Correct use of UTF-8 in Panic Callback (Windows only) check-in: e2d9683a48 user: jan.nijtmans tags: core-8-branch
09:20
Merge 8.5. This adds Emoji 11.0 support, when Tcl is compiled with TCL_UTF_MAX>3. Useful for Androwi... check-in: 708287d936 user: jan.nijtmans tags: core-8-6-branch
08:12
merge 8.6 check-in: 61bcb3ad68 user: jan.nijtmans tags: core-8-branch
2018-03-15
23:01
In case of redirecting stderr to a file on Windows, append CRLF after Panic output. Closed-Leaf check-in: 224ba13ab4 user: jan.nijtmans tags: win-console-panic
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to doc/Panic.3.

3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23



24
25
26
27
28
29
30
..
49
50
51
52
53
54
55








56
57
58
59
60
61
62
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_Panic 3 8.4 Tcl "Tcl Library Procedures"
.so man.macros
.BS
'\"  Note:  do not modify the .SH NAME line immediately below!
.SH NAME
Tcl_Panic, Tcl_PanicVA, Tcl_SetPanicProc \- report fatal error and abort
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
void
\fBTcl_Panic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR)
.sp
void
\fBTcl_PanicVA\fR(\fIformat\fR, \fIargList\fR)
.sp
void
\fBTcl_SetPanicProc\fR(\fIpanicProc\fR)
.sp



.SH ARGUMENTS
.AS Tcl_PanicProc *panicProc
.AP "const char*" format in
A printf-style format string.
.AP "" arg in
Arguments matching the format string.
.AP va_list argList in
................................................................................
In a freshly loaded Tcl library, \fBTcl_Panic\fR prints the formatted
error message to the standard error file of the process, and then
calls \fBabort\fR to terminate the process.  \fBTcl_Panic\fR does not
return. On Windows, when a debugger is running, the formatted error
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
\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:
.PP
.CS
typedef void \fBTcl_PanicProc\fR(






|













>
>
>







 







>
>
>
>
>
>
>
>







3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
..
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_Panic 3 8.4 Tcl "Tcl Library Procedures"
.so man.macros
.BS
'\"  Note:  do not modify the .SH NAME line immediately below!
.SH NAME
Tcl_Panic, Tcl_PanicVA, Tcl_SetPanicProc, Tcl_ConsolePanic \- report fatal error and abort
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
void
\fBTcl_Panic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR)
.sp
void
\fBTcl_PanicVA\fR(\fIformat\fR, \fIargList\fR)
.sp
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
A printf-style format string.
.AP "" arg in
Arguments matching the format string.
.AP va_list argList in
................................................................................
In a freshly loaded Tcl library, \fBTcl_Panic\fR prints the formatted
error message to the standard error file of the process, and then
calls \fBabort\fR to terminate the process.  \fBTcl_Panic\fR does not
return. On Windows, when a debugger is running, the formatted error
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)
\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:
.PP
.CS
typedef void \fBTcl_PanicProc\fR(

Changes to generic/tcl.h.

2357
2358
2359
2360
2361
2362
2363





2364
2365
2366
2367
2368
2369
2370
....
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
 * main library in case an extension is statically linked into an application.
 */

const char *		Tcl_InitStubs(Tcl_Interp *interp, const char *version,
			    int exact, int magic);
const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
			    const char *version, int epoch, int revision);






#ifdef USE_TCL_STUBS
#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
#   define Tcl_InitStubs(interp, version, exact) \
	(Tcl_InitStubs)(interp, version, \
	    (exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
	    TCL_STUB_MAGIC)
................................................................................

/*
 * Public functions that are not accessible via the stubs table.
 * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171]
 */

#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
	    ((Tcl_CreateInterp)()))
EXTERN void		Tcl_MainEx(int argc, char **argv,
			    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
EXTERN const char *	Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
			    const char *version, int exact);
EXTERN void		Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
 
/*






>
>
>
>
>







 







|







2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
....
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
 * main library in case an extension is statically linked into an application.
 */

const char *		Tcl_InitStubs(Tcl_Interp *interp, const char *version,
			    int exact, int magic);
const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
			    const char *version, int epoch, int revision);
#if defined(_WIN32)
    TCL_NORETURN void Tcl_ConsolePanic(const char *format, ...);
#else
#   define Tcl_ConsolePanic ((Tcl_PanicProc *)0)
#endif

#ifdef USE_TCL_STUBS
#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
#   define Tcl_InitStubs(interp, version, exact) \
	(Tcl_InitStubs)(interp, version, \
	    (exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
	    TCL_STUB_MAGIC)
................................................................................

/*
 * Public functions that are not accessible via the stubs table.
 * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171]
 */

#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
	    ((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,
			    const char *version, int exact);
EXTERN void		Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
 
/*

Changes to generic/tclPanic.c.

19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
#endif

/*
 * The panicProc variable contains a pointer to an application specific panic
 * procedure.
 */

#if defined(__CYGWIN__)
static TCL_NORETURN Tcl_PanicProc *panicProc = tclWinDebugPanic;
#else
static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL;
#endif
 
/*
 *----------------------------------------------------------------------






|







19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
#endif

/*
 * The panicProc variable contains a pointer to an application specific panic
 * procedure.
 */

#if defined(__CYGWIN__) || (defined(_WIN32) && (defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8))
static TCL_NORETURN Tcl_PanicProc *panicProc = tclWinDebugPanic;
#else
static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL;
#endif
 
/*
 *----------------------------------------------------------------------

Changes to win/Makefile.in.

397
398
399
400
401
402
403
404

405
406
407
408
409
410
411
...
534
535
536
537
538
539
540



541
542
543
544
545
546
547
DDE_OBJS = tclWinDde.$(OBJEXT)

REG_OBJS = tclWinReg.$(OBJEXT)

STUB_OBJS = \
	tclStubLib.$(OBJEXT) \
	tclTomMathStubLib.$(OBJEXT) \
	tclOOStubLib.$(OBJEXT)


TCLSH_OBJS = tclAppInit.$(OBJEXT)

ZLIB_OBJS = \
	adler32.$(OBJEXT) \
	compress.$(OBJEXT) \
	crc32.$(OBJEXT) \
................................................................................

tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c
	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @[email protected] $(CC_OBJNAME)

tclOOStubLib.${OBJEXT}: tclOOStubLib.c
	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @[email protected] $(CC_OBJNAME)




# Implicit rule for all object files that will end up in the Tcl library

%.${OBJEXT}: %.c
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl @[email protected] $(CC_OBJNAME)

.rc.$(RES):
	$(RC) @[email protected] [email protected] @[email protected] @[email protected] @[email protected] "$(GENERIC_DIR_NATIVE)" @[email protected] "$(WIN_DIR_NATIVE)" @[email protected]






|
>







 







>
>
>







397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
...
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
DDE_OBJS = tclWinDde.$(OBJEXT)

REG_OBJS = tclWinReg.$(OBJEXT)

STUB_OBJS = \
	tclStubLib.$(OBJEXT) \
	tclTomMathStubLib.$(OBJEXT) \
	tclOOStubLib.$(OBJEXT) \
	tclWinPanic.$(OBJEXT)

TCLSH_OBJS = tclAppInit.$(OBJEXT)

ZLIB_OBJS = \
	adler32.$(OBJEXT) \
	compress.$(OBJEXT) \
	crc32.$(OBJEXT) \
................................................................................

tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c
	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @[email protected] $(CC_OBJNAME)

tclOOStubLib.${OBJEXT}: tclOOStubLib.c
	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @[email protected] $(CC_OBJNAME)

tclWinPanic.${OBJEXT}: tclWinPanic.c
	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @[email protected] $(CC_OBJNAME)

# Implicit rule for all object files that will end up in the Tcl library

%.${OBJEXT}: %.c
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl @[email protected] $(CC_OBJNAME)

.rc.$(RES):
	$(RC) @[email protected] [email protected] @[email protected] @[email protected] @[email protected] "$(GENERIC_DIR_NATIVE)" @[email protected] "$(WIN_DIR_NATIVE)" @[email protected]

Changes to win/makefile.vc.

346
347
348
349
350
351
352
353

354
355
356
357
358
359
360
...
736
737
738
739
740
741
742



743
744
745
746
747
748
749
!endif

TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS)

TCLSTUBOBJS = \
	$(TMP_DIR)\tclStubLib.obj \
	$(TMP_DIR)\tclTomMathStubLib.obj \
	$(TMP_DIR)\tclOOStubLib.obj


### The following paths CANNOT have spaces in them as they appear on
### the left side of implicit rules.
TOMMATHDIR	= $(ROOT)\libtommath
PKGSDIR		= $(ROOT)\pkgs

# Additional include and C macro definitions for the implicit rules
................................................................................
	$(cc32) $(stubscflags) [email protected] $?

$(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c
	$(cc32) $(stubscflags) [email protected] $?

$(TMP_DIR)\tclOOStubLib.obj: $(GENERICDIR)\tclOOStubLib.c
	$(cc32) $(stubscflags) [email protected] $?




$(TMP_DIR)\tclsh.exe.manifest: $(WINDIR)\tclsh.exe.manifest.in
	@nmakehlp -s << $** >$@
@[email protected]	  $(MACHINE:IX86=X86)
@[email protected]  $(DOTVERSION).0.0
<<







|
>







 







>
>
>







346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
...
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
!endif

TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS)

TCLSTUBOBJS = \
	$(TMP_DIR)\tclStubLib.obj \
	$(TMP_DIR)\tclTomMathStubLib.obj \
	$(TMP_DIR)\tclOOStubLib.obj \
	$(TMP_DIR)\tclWinPanic.obj

### The following paths CANNOT have spaces in them as they appear on
### the left side of implicit rules.
TOMMATHDIR	= $(ROOT)\libtommath
PKGSDIR		= $(ROOT)\pkgs

# Additional include and C macro definitions for the implicit rules
................................................................................
	$(cc32) $(stubscflags) [email protected] $?

$(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c
	$(cc32) $(stubscflags) [email protected] $?

$(TMP_DIR)\tclOOStubLib.obj: $(GENERICDIR)\tclOOStubLib.c
	$(cc32) $(stubscflags) [email protected] $?

$(TMP_DIR)\tclWinPanic.obj: $(WINDIR)\tclWinPanic.c
	$(cc32) $(stubscflags) [email protected] $?

$(TMP_DIR)\tclsh.exe.manifest: $(WINDIR)\tclsh.exe.manifest.in
	@nmakehlp -s << $** >[email protected]
@[email protected]	  $(MACHINE:IX86=X86)
@[email protected]  $(DOTVERSION).0.0
<<

Changes to win/tcl.dsp.

1523
1524
1525
1526
1527
1528
1529




1530
1531
1532
1533
1534
1535
1536
SOURCE=.\tclWinLoad.c
# End Source File
# Begin Source File

SOURCE=.\tclWinNotify.c
# End Source File
# Begin Source File





SOURCE=.\tclWinPipe.c
# End Source File
# Begin Source File

SOURCE=.\tclWinPort.h
# End Source File






>
>
>
>







1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
SOURCE=.\tclWinLoad.c
# End Source File
# Begin Source File

SOURCE=.\tclWinNotify.c
# End Source File
# Begin Source File

SOURCE=.\tclWinPanic.c
# End Source File
# Begin Source File

SOURCE=.\tclWinPipe.c
# End Source File
# Begin Source File

SOURCE=.\tclWinPort.h
# End Source File

Changes to win/tclWinError.c.

402
403
404
405
406
407
408



409
410
411
412
413
414
415
	 */

	if (msgString[TCL_MAX_WARN_LEN-1] != L'\0') {
	    memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR));
	}
	OutputDebugStringW(msgString);
    } else {



	vfprintf(stderr, format, argList);
	fprintf(stderr, "\n");
	fflush(stderr);
    }
#   if defined(__GNUC__)
    __builtin_trap();
#   else






>
>
>







402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
	 */

	if (msgString[TCL_MAX_WARN_LEN-1] != L'\0') {
	    memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR));
	}
	OutputDebugStringW(msgString);
    } else {
	if (!isatty(fileno(stderr))) {
	    fprintf(stderr, "\xef\xbb\xbf");
	}
	vfprintf(stderr, format, argList);
	fprintf(stderr, "\n");
	fflush(stderr);
    }
#   if defined(__GNUC__)
    __builtin_trap();
#   else

Added win/tclWinPanic.c.
















































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
/*
 * 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];
    HANDLE handle = GetStdHandle(STD_ERROR_HANDLE);
    DWORD dummy;

    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);
    } 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);
	WriteFile(handle, "\n", 1, &dummy, 0);
	FlushFileBuffers(handle);
    }
#   if defined(__GNUC__)
	__builtin_trap();
#   elif defined(_WIN64)
	__debugbreak();
#   elif defined(_MSC_VER)
	_asm {int 3}
#   else
	DebugBreak();
#   endif
#if defined(_WIN32)
	ExitProcess(1);
#else
	abort();
#endif
}
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * End:
 */