summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-04-29 07:23:07 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-04-29 07:23:07 (GMT)
commit42e171af9f7d955cce861026cfccd61e950256e3 (patch)
tree1260f679767f5188f8a2b40b8f1f2953f8cd0417
parent6dc349d4991d4514c4419c39e9918cf4c7998cfd (diff)
parent4afd3525b5e7ea01272b07281dd65833bdb885d7 (diff)
downloadtcl-42e171af9f7d955cce861026cfccd61e950256e3.zip
tcl-42e171af9f7d955cce861026cfccd61e950256e3.tar.gz
tcl-42e171af9f7d955cce861026cfccd61e950256e3.tar.bz2
merge trunk
-rw-r--r--ChangeLog28
-rw-r--r--doc/close.n6
-rw-r--r--generic/tclEnv.c1
-rw-r--r--generic/tclIO.c37
-rw-r--r--generic/tclIOCmd.c2
-rw-r--r--generic/tclPort.h13
-rw-r--r--generic/tclStubInit.c32
-rw-r--r--generic/tclTest.c2
-rw-r--r--library/init.tcl2
-rw-r--r--tests/io.test21
-rw-r--r--unix/tclUnixChan.c2
-rw-r--r--unix/tclUnixFile.c11
-rw-r--r--unix/tclUnixPort.h13
-rw-r--r--win/tclWinInit.c2
14 files changed, 119 insertions, 53 deletions
diff --git a/ChangeLog b/ChangeLog
index bf2201b..b431346 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,31 @@
+2012-14-28 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ IMPLEMENTATION OF TIP#398
+
+ * generic/tclIO.c: Quickly Exit with Non-Blocking Blocked Channels
+ * tests/io.test
+ * doc/close.n
+
+2012-04-27 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * 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 <dkf@users.sf.net>
+
+ * library/init.tcl (auto_execok): Allow shell builtins to be detected
+ even if they are upper-cased.
+
+2012-04-26 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclStubInit.c: get rid of _ANSI_ARGS_ and CONST
+ * generic/tclIO.c
+ * generic/tclIOCmd.c
+ * generic/tclTest.c
+ * unix/tclUnixChan.c
+
2012-04-25 Donal K. Fellows <dkf@users.sf.net>
* generic/tclUtil.c (TclDStringToObj): Added internal function to make
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/tclEnv.c b/generic/tclEnv.c
index 72d6fba..e45ae6a 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -698,6 +698,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/tclIO.c b/generic/tclIO.c
index 96e6de3..b06c14d 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)
- || GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
+ if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED | CHANNEL_DEAD)
+ || (doflushnb && GotFlag(statePtr, BG_FLUSH_SCHEDULED))) {
active = 1;
break;
}
@@ -426,13 +439,21 @@ TclFinalizeIOSubsystem(void)
*/
if (active) {
+
/*
- * Set the channel back into blocking mode to ensure that we wait
- * for all data to flush out.
+ * 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".
*/
-
- (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
- "-blocking", "on");
+ 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) ||
@@ -8856,7 +8877,7 @@ Tcl_FileEventObjCmd(
int modeIndex; /* Index of mode argument. */
int mask;
static const char *const modeOptions[] = {"readable", "writable", NULL};
- static CONST int maskArray[] = {TCL_READABLE, TCL_WRITABLE};
+ static const int maskArray[] = {TCL_READABLE, TCL_WRITABLE};
if ((objc != 3) && (objc != 4)) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?");
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index b22d746..59856d0 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -521,7 +521,7 @@ Tcl_SeekObjCmd(
static const char *const originOptions[] = {
"start", "current", "end", NULL
};
- static CONST int modeArray[] = {SEEK_SET, SEEK_CUR, SEEK_END};
+ static const int modeArray[] = {SEEK_SET, SEEK_CUR, SEEK_END};
if ((objc != 3) && (objc != 4)) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId offset ?origin?");
diff --git a/generic/tclPort.h b/generic/tclPort.h
index d9361ca..7021b8d 100644
--- a/generic/tclPort.h
+++ b/generic/tclPort.h
@@ -25,19 +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);
- //DLLIMPORT extern void __stdcall SetEnvironmentVariableA(const char*, const char *);
-#endif
-
#if !defined(LLONG_MIN)
# ifdef TCL_WIDE_INT_IS_LONG
# define LLONG_MIN LONG_MIN
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 8c0eff6..545ef72 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -171,28 +171,28 @@ Tcl_WinTCharToUtf(
string, len, dsPtr);
}
-#define Tcl_MacOSXOpenBundleResources (int (*) _ANSI_ARGS_(( \
- Tcl_Interp *, const char *, int, int, char *))) Tcl_WinUtfToTChar
-#define Tcl_MacOSXOpenVersionedBundleResources (int (*) _ANSI_ARGS_(( \
- Tcl_Interp *, const char *, const char *, int, int, char *))) Tcl_WinTCharToUtf
-#define TclMacOSXGetFileAttribute (int (*) _ANSI_ARGS_((Tcl_Interp *, \
- int, Tcl_Obj *, Tcl_Obj **))) TclpCreateProcess
-#define TclMacOSXMatchType (int (*) _ANSI_ARGS_((Tcl_Interp *, const char *, \
- const char *, Tcl_StatBuf *, Tcl_GlobTypeData *))) TclpMakeFile
-#define TclMacOSXNotifierAddRunLoopMode (void (*) _ANSI_ARGS_((const void *))) TclpOpenFile
-#define TclpLocaltime_unix (struct tm *(*) _ANSI_ARGS_((const time_t *))) TclGetAndDetachPids
-#define TclpGmtime_unix (struct tm *(*) _ANSI_ARGS_((const time_t *))) TclpCloseFile
+#define Tcl_MacOSXOpenBundleResources (int (*) ( \
+ Tcl_Interp *, const char *, int, int, char *)) Tcl_WinUtfToTChar
+#define Tcl_MacOSXOpenVersionedBundleResources (int (*) ( \
+ Tcl_Interp *, const char *, const char *, int, int, char *)) Tcl_WinTCharToUtf
+#define TclMacOSXGetFileAttribute (int (*) (Tcl_Interp *, \
+ int, Tcl_Obj *, Tcl_Obj **)) TclpCreateProcess
+#define TclMacOSXMatchType (int (*) (Tcl_Interp *, const char *, \
+ const char *, Tcl_StatBuf *, Tcl_GlobTypeData *)) TclpMakeFile
+#define TclMacOSXNotifierAddRunLoopMode (void (*) (const void *)) TclpOpenFile
+#define TclpLocaltime_unix (struct tm *(*) (const time_t *)) TclGetAndDetachPids
+#define TclpGmtime_unix (struct tm *(*) (const time_t *)) TclpCloseFile
#elif !defined(__WIN32__) /* UNIX and MAC */
-# define TclWinConvertError (void (*) _ANSI_ARGS_((unsigned int))) TclGetAndDetachPids
+# define TclWinConvertError (void (*) (unsigned int)) TclGetAndDetachPids
# undef TclWinConvertWSAError
-# define TclWinConvertWSAError (void (*) _ANSI_ARGS_((unsigned int))) TclpCloseFile
+# define TclWinConvertWSAError (void (*) (unsigned int)) TclpCloseFile
# define TclWinGetPlatformId (int (*)()) TclpCreateTempFile
# 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 TclWinGetServByName (struct servent *(*) _ANSI_ARGS_((const char *nm, const char *proto))) TclpCreateCommandChannel
+# define TclWinSetSockOpt (int (*) (void *, int, int, const char *, int)) TclpOpenFile
+# define TclWinGetSockOpt (int (*) (void *, int, int, char *, int *)) TclpCreatePipe
+# define TclWinGetServByName (struct servent *(*) (const char *nm, const char *proto)) TclpCreateCommandChannel
# define TclIntPlatReserved13 (void (*) ()) TclpInetNtoa
# define TclWinAddProcess 0
# define TclWinNoBackslash 0
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 004fadc..7631dee 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -3262,7 +3262,7 @@ TestlocaleCmd(
"ctype", "numeric", "time", "collate", "monetary",
"all", NULL
};
- static CONST int lcTypes[] = {
+ static const int lcTypes[] = {
LC_CTYPE, LC_NUMERIC, LC_TIME, LC_COLLATE, LC_MONETARY,
LC_ALL
};
diff --git a/library/init.tcl b/library/init.tcl
index 685fc7b..d8de540 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -651,7 +651,7 @@ proc auto_execok name {
set execExtensions [list {} .com .exe .bat .cmd]
}
- if {$name in $shellBuiltins} {
+ if {[string tolower $name] in $shellBuiltins} {
# 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.
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
}
diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c
index db137aa..b05a9f2 100644
--- a/unix/tclUnixChan.c
+++ b/unix/tclUnixChan.c
@@ -981,7 +981,7 @@ TtyGetOptionProc(
# define TtyGetBaud(speed) ((int) (speed))
#else /* !DIRECT_BAUD */
-static CONST struct {int baud; unsigned long speed;} speeds[] = {
+static const struct {int baud; unsigned long speed;} speeds[] = {
#ifdef B0
{0, B0},
#endif
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index b4a1012..a4426b7 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -39,6 +39,7 @@ 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];
@@ -46,9 +47,9 @@ TclpFindExecutable(
/* Make some symbols available without including <windows.h> */
# 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);
@@ -59,13 +60,13 @@ TclpFindExecutable(
/* Strip '.exe' part. */
length -= 4;
}
+ encoding = Tcl_GetEncoding(NULL, NULL);
TclSetObjNameOfExecutable(
- Tcl_NewStringObj(name, length), Tcl_GetEncoding(NULL, NULL));
+ Tcl_NewStringObj(name, length), encoding);
#else
const char *name, *p;
Tcl_StatBuf statBuf;
Tcl_DString buffer, nameString, cwd, utfName;
- Tcl_Encoding encoding;
if (argv0 == NULL) {
return;
diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h
index 98ef3c8..22872e4 100644
--- a/unix/tclUnixPort.h
+++ b/unix/tclUnixPort.h
@@ -79,8 +79,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
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index 3bfff63..d89c98e 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -288,8 +288,6 @@ AppendEnvironment(
*/
if ((pathc > 0) && (lstrcmpiA(shortlib, pathv[pathc - 1]) != 0)) {
- const char *str;
-
/*
* TCL_LIBRARY is set but refers to a different tcl installation
* than the current version. Try fiddling with the specified