From 4469b8019b142def58d2f77fae3229675667eefe Mon Sep 17 00:00:00 2001 From: ferrieux Date: Thu, 22 Mar 2012 07:33:06 +0000 Subject: Implement tip 398 : Quickly Exit with Non-Blocking Blocked Channels. This is simply a revert of the (C part of the) 1025712d5b commit of 2011-08-17. --- generic/tclIO.c | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 082cf70..cf875a8 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -414,8 +414,8 @@ TclFinalizeIOSubsystem(void) statePtr != NULL; statePtr = statePtr->nextCSPtr) { chanPtr = statePtr->topChanPtr; - if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED | CHANNEL_DEAD) - || GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { + if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED | + CHANNEL_DEAD)) { active = 1; break; } @@ -458,7 +458,6 @@ TclFinalizeIOSubsystem(void) * The refcount is greater than zero, so flush the channel. */ - ResetFlag(statePtr, BG_FLUSH_SCHEDULED); Tcl_Flush((Tcl_Channel) chanPtr); /* -- cgit v0.12 From 5a62da3750ddfade44c3113b96e1f5c7a0cef1f1 Mon Sep 17 00:00:00 2001 From: ferrieux Date: Thu, 22 Mar 2012 08:04:09 +0000 Subject: Take two. Don't forget to apply all patches, even when the phone rings in between. --- generic/tclIO.c | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index cf875a8..7888352 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -427,13 +427,9 @@ TclFinalizeIOSubsystem(void) if (active) { /* - * Set the channel back into blocking mode to ensure that we wait - * for all data to flush out. + * TIP #398: we no longer set the channel back into blocking mode */ - (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr, - "-blocking", "on"); - if ((chanPtr == (Channel *) tsdPtr->stdinChannel) || (chanPtr == (Channel *) tsdPtr->stdoutChannel) || (chanPtr == (Channel *) tsdPtr->stderrChannel)) { -- cgit v0.12 From 4ff4797d7f983f119eb1f4df6b88bcf5850331a9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 26 Apr 2012 14:59:50 +0000 Subject: compiler warning --- generic/tclStubInit.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 7ce50ba..03b363d 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -212,7 +212,7 @@ Tcl_WinTCharToUtf( # define TclWinGetTclInstance (void *(*)()) TclpCreateProcess # define TclWinNToHS (unsigned short (*) _ANSI_ARGS_((unsigned short ns))) TclpMakeFile # define TclWinSetSockOpt (int (*) _ANSI_ARGS_((void *, int, int, const char *, int))) TclpOpenFile -# define TclWinGetSockOpt (int (*) _ANSI_ARGS_((void *, int, int, char *, int))) TclpCreatePipe +# define TclWinGetSockOpt (int (*) _ANSI_ARGS_((void *, int, int, char *, int *))) TclpCreatePipe # define TclWinGetServByName (struct servent *(*) _ANSI_ARGS_((const char *nm, const char *proto))) TclpCreateCommandChannel # define TclIntPlatReserved13 (void (*) ()) TclpInetNtoa # define TclWinAddProcess 0 -- cgit v0.12 From cd9e8f06c4f0e83231558995f26f7c02bdab2ac9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 26 Apr 2012 15:03:03 +0000 Subject: compiler warning --- generic/tclStubInit.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 8b6e22b..3b39416 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -206,7 +206,7 @@ Tcl_WinTCharToUtf( # define TclWinGetTclInstance (void *(*)()) TclpCreateProcess # define TclWinNToHS (unsigned short (*) _ANSI_ARGS_((unsigned short ns))) TclpMakeFile # define TclWinSetSockOpt (int (*) _ANSI_ARGS_((void *, int, int, CONST char *, int))) TclpOpenFile -# define TclWinGetSockOpt (int (*) _ANSI_ARGS_((void *, int, int, char *, int))) TclpCreatePipe +# define TclWinGetSockOpt (int (*) _ANSI_ARGS_((void *, int, int, char *, int *))) TclpCreatePipe # define TclWinGetServByName (struct servent *(*) _ANSI_ARGS_((const char *nm, const char *proto))) TclpCreateCommandChannel # define TclIntPlatReserved13 (void (*) ()) TclpInetNtoa # define TclWinAddProcess 0 -- cgit v0.12 From d0206ab72a48d29bbdf3814853a857d29fe6923f Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 27 Apr 2012 08:46:47 +0000 Subject: Make 'auto_execok START' do the Right Thing --- ChangeLog | 5 +++++ library/init.tcl | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index 7484912..58750bd 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-04-27 Donal K. Fellows + + * library/init.tcl (auto_execok): Allow shell builtins to be detected + even if they are upper-cased. + 2012-04-24 Jan Nijtmans * generic/tclInt.decls: [Bug 3508771] load tclreg.dll in cygwin tclsh diff --git a/library/init.tcl b/library/init.tcl index 8a53c69..f2f85e1 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -580,7 +580,7 @@ proc auto_execok name { set execExtensions [list {} .com .exe .bat] } - if {[lsearch -exact $shellBuiltins $name] != -1} { + if {[lsearch -exact $shellBuiltins [string tolower $name]] != -1} { # When this is command.com for some reason on Win2K, Tcl won't # exec it unless the case is right, which this corrects. COMSPEC # may not point to a real file, so do the check. -- cgit v0.12 From 4457676798e94230b3296a67ab9caed2dc95e8d5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 27 Apr 2012 14:30:23 +0000 Subject: Move CYGWIN-specific stuff from tclPort.h to tclUnixPort.h, where it belongs --- ChangeLog | 7 +++++++ generic/tclEnv.c | 1 + generic/tclPort.h | 12 ------------ unix/tclUnixFile.c | 26 ++++++++++++-------------- unix/tclUnixPort.h | 13 +++++++++++-- 5 files changed, 31 insertions(+), 28 deletions(-) diff --git a/ChangeLog b/ChangeLog index 655a8ee..4667490 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2012-04-27 Jan Nijtmans + + * generic/tclPort.h: Move CYGWIN-specific stuff from tclPort.h to + * generic/tclEnv.c: tclUnixPort.h, where it belongs. + * unix/tclUnixPort.h: + * unix/tclUnixFile.c: + 2012-04-27 Donal K. Fellows * library/init.tcl (auto_execok): Allow shell builtins to be detected diff --git a/generic/tclEnv.c b/generic/tclEnv.c index 24fa106..bcc0ff1 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -696,6 +696,7 @@ TclFinalizeEnvironment(void) * fork) and the Windows environment (in case the application TCL code calls * exec, which calls the Windows CreateProcess function). */ +DLLIMPORT extern void __stdcall SetEnvironmentVariableA(const char*, const char *); static void TclCygwinPutenv( diff --git a/generic/tclPort.h b/generic/tclPort.h index 7c9bf3c..7021b8d 100644 --- a/generic/tclPort.h +++ b/generic/tclPort.h @@ -25,18 +25,6 @@ # include "tclUnixPort.h" #endif -#if defined(__CYGWIN__) -# define USE_PUTENV 1 -# define USE_PUTENV_FOR_UNSET 1 -/* On Cygwin, the environment is imported from the Cygwin DLL. */ -# define environ __cygwin_environ -# define timezone _timezone - DLLIMPORT extern char **__cygwin_environ; - DLLIMPORT extern int cygwin_conv_to_win32_path(const char *, char *); - DLLIMPORT extern int cygwin_posix_to_win32_path_list_buf_size(char *value); - DLLIMPORT extern void cygwin_posix_to_win32_path_list(char *buf, char *value); -#endif - #if !defined(LLONG_MIN) # ifdef TCL_WIDE_INT_IS_LONG # define LLONG_MIN LONG_MIN diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 8fb9fd9..f428af7 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -39,23 +39,17 @@ TclpFindExecutable( CONST char *argv0) /* The value of the application's argv[0] * (native). */ { + Tcl_Encoding encoding; #ifdef __CYGWIN__ + int length; char buf[PATH_MAX * TCL_UTF_MAX + 1]; char name[PATH_MAX * TCL_UTF_MAX + 1]; -#else - CONST char *name, *p; - Tcl_StatBuf statBuf; - Tcl_DString buffer, nameString, cwd, utfName; - Tcl_Encoding encoding; -#endif - -#ifdef __CYGWIN__ /* Make some symbols available without including */ # define CP_UTF8 65001 - extern int cygwin_conv_to_full_posix_path(const char *, char *); - extern __stdcall int GetModuleFileNameW(void *, const char *, int); - extern __stdcall int WideCharToMultiByte(int, int, const char *, int, + DLLIMPORT extern int cygwin_conv_to_full_posix_path(const char *, char *); + DLLIMPORT extern __stdcall int GetModuleFileNameW(void *, const char *, int); + DLLIMPORT extern __stdcall int WideCharToMultiByte(int, int, const char *, int, const char *, int, const char *, const char *); GetModuleFileNameW(NULL, name, PATH_MAX); @@ -66,10 +60,14 @@ TclpFindExecutable( /* Strip '.exe' part. */ length -= 4; } - tclNativeExecutableName = (char *) ckalloc(length + 1); - memcpy(tclNativeExecutableName, name, length); - buf[length] = '\0'; + encoding = Tcl_GetEncoding(NULL, NULL); + TclSetObjNameOfExecutable( + Tcl_NewStringObj(name, length), encoding); #else + const char *name, *p; + Tcl_StatBuf statBuf; + Tcl_DString buffer, nameString, cwd, utfName; + if (argv0 == NULL) { return; } diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h index 5abe602..70ea2d4 100644 --- a/unix/tclUnixPort.h +++ b/unix/tclUnixPort.h @@ -74,8 +74,17 @@ typedef off_t Tcl_SeekOffset; #endif #ifdef __CYGWIN__ -MODULE_SCOPE int TclOSstat(const char *name, Tcl_StatBuf *statBuf); -MODULE_SCOPE int TclOSlstat(const char *name, Tcl_StatBuf *statBuf); +# define USE_PUTENV 1 +# define USE_PUTENV_FOR_UNSET 1 +/* On Cygwin, the environment is imported from the Cygwin DLL. */ +# define environ __cygwin_environ +# define timezone _timezone + DLLIMPORT extern char **__cygwin_environ; + DLLIMPORT extern int cygwin_conv_to_win32_path(const char *, char *); + DLLIMPORT extern int cygwin_posix_to_win32_path_list_buf_size(char *value); + DLLIMPORT extern void cygwin_posix_to_win32_path_list(char *buf, char *value); + MODULE_SCOPE int TclOSstat(const char *name, Tcl_StatBuf *statBuf); + MODULE_SCOPE int TclOSlstat(const char *name, Tcl_StatBuf *statBuf); #elif defined(HAVE_STRUCT_STAT64) # define TclOSstat stat64 # define TclOSlstat lstat64 -- cgit v0.12 From 39e076480d96baa096f628753c88b68eb9d7f601 Mon Sep 17 00:00:00 2001 From: ferrieux Date: Sat, 28 Apr 2012 17:03:10 +0000 Subject: Compat flag, test, and doc update. --- doc/close.n | 6 ++++-- generic/tclIO.c | 32 +++++++++++++++++++++++++++++--- tests/io.test | 21 ++++++++++++++++++++- 3 files changed, 53 insertions(+), 6 deletions(-) diff --git a/doc/close.n b/doc/close.n index 4490f6a..2826d82 100644 --- a/doc/close.n +++ b/doc/close.n @@ -48,8 +48,10 @@ When the last interpreter in which the channel is registered invokes \fBinterp\fR command for a description of channel sharing. .PP Channels are automatically closed when an interpreter is destroyed and -when the process exits. Channels are switched to blocking mode, to ensure -that all output is correctly flushed before the process exits. +when the process exits. +.VS 8.6 +From 8.6 on (TIP#398), nonblocking channels are no longer switched to blocking mode when exiting; this guarantees a timely exit even when the peer or a communication channel is stalled. To ensure proper flushing of stalled nonblocking channels on exit, one must now either (a) actively switch them back to blocking or (b) use the environment variable TCL_FLUSH_NONBLOCKING_ON_EXIT, which when set and not equal to "0" restores the previous behavior. +.VE 8.6 .PP The command returns an empty string, and may generate an error if an error occurs while flushing output. If a command in a command diff --git a/generic/tclIO.c b/generic/tclIO.c index e1e1193..527ae0c 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -396,6 +396,19 @@ TclFinalizeIOSubsystem(void) Channel *chanPtr = NULL; /* Iterates over open channels. */ ChannelState *statePtr; /* State of channel stack */ int active = 1; /* Flag == 1 while there's still work to do */ + int doflushnb; + + /* Fetch the pre-TIP#398 compatibility flag */ + { + const char *s; + Tcl_DString ds; + + s = TclGetEnv("TCL_FLUSH_NONBLOCKING_ON_EXIT", &ds); + doflushnb = ((s != NULL) && strcmp(s, "0")); + if (s != NULL) { + Tcl_DStringFree(&ds); + } + } /* * Walk all channel state structures known to this thread and close @@ -414,8 +427,8 @@ TclFinalizeIOSubsystem(void) statePtr != NULL; statePtr = statePtr->nextCSPtr) { chanPtr = statePtr->topChanPtr; - if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED | - CHANNEL_DEAD)) { + if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED | CHANNEL_DEAD) + || (doflushnb && GotFlag(statePtr, BG_FLUSH_SCHEDULED))) { active = 1; break; } @@ -426,9 +439,21 @@ TclFinalizeIOSubsystem(void) */ if (active) { + /* - * TIP #398: we no longer set the channel back into blocking mode + * TIP #398: by default, we no longer set the channel back into + * blocking mode. To restore the old blocking behavior, the + * environment variable TCL_FLUSH_NONBLOCKING_ON_EXIT must be set + * and not be "0". */ + if (doflushnb) { + /* Set the channel back into blocking mode to ensure that we wait + * for all data to flush out. + */ + + (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr, + "-blocking", "on"); + } if ((chanPtr == (Channel *) tsdPtr->stdinChannel) || (chanPtr == (Channel *) tsdPtr->stdoutChannel) || @@ -454,6 +479,7 @@ TclFinalizeIOSubsystem(void) * The refcount is greater than zero, so flush the channel. */ + ResetFlag(statePtr, BG_FLUSH_SCHEDULED); Tcl_Flush((Tcl_Channel) chanPtr); /* diff --git a/tests/io.test b/tests/io.test index 53b85fa..74a246c 100644 --- a/tests/io.test +++ b/tests/io.test @@ -2736,6 +2736,25 @@ test io-29.33 {Tcl_Flush, implicit flush on exit} {exec} { close $f set r } "hello\nbye\nstrange\n" +set path(script2) [makeFile {} script2] +test io-29.33b {TIP#398, no implicit flush of nonblocking on exit} {exec} { + set f [open $path(script) w] + puts $f { + fconfigure stdout -blocking 0 + puts -nonewline stdout [string repeat A 655360] + flush stdout + } + close $f + set f [open $path(script2) w] + puts $f {after 2000} + close $f + set t1 [clock seconds] + set ff [open "|[list [interpreter] $path(script2)]" w] + exec [interpreter] $path(script) >@ $ff + set t2 [clock seconds] + close $ff + expr {($t2-$t1)/2} +} 0 test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMac fileevent} { variable c 0 variable x running @@ -7761,7 +7780,7 @@ test io-73.2 {channel Tcl_Obj SetChannelFromAny, bug 2407783} -setup { # ### ### ### ######### ######### ######### # cleanup -foreach file [list fooBar longfile script output test1 pipe my_script \ +foreach file [list fooBar longfile script script2 output test1 pipe my_script \ test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] { removeFile $file } -- cgit v0.12