diff options
-rw-r--r-- | generic/tclIO.c | 23 | ||||
-rw-r--r-- | generic/tclIORChan.c | 2 | ||||
-rw-r--r-- | tests/ioCmd.test | 14 | ||||
-rw-r--r-- | tests/iogt.test | 33 | ||||
-rw-r--r-- | unix/Makefile.in | 10 | ||||
-rwxr-xr-x | unix/configure | 3 | ||||
-rw-r--r-- | unix/configure.in | 1 | ||||
-rw-r--r-- | unix/tcl.pc.in | 15 |
8 files changed, 94 insertions, 7 deletions
diff --git a/generic/tclIO.c b/generic/tclIO.c index 3636861..c43e61e 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -3852,6 +3852,7 @@ Tcl_GetsObj( */ chanPtr = statePtr->topChanPtr; + Tcl_Preserve(chanPtr); bufPtr = statePtr->inQueueHead; encoding = statePtr->encoding; @@ -4144,6 +4145,7 @@ Tcl_GetsObj( done: UpdateInterest(chanPtr); + Tcl_Release(chanPtr); return copiedTotal; } @@ -4189,6 +4191,7 @@ TclGetsObjBinary( */ chanPtr = statePtr->topChanPtr; + Tcl_Preserve(chanPtr); bufPtr = statePtr->inQueueHead; @@ -4388,6 +4391,7 @@ TclGetsObjBinary( done: UpdateInterest(chanPtr); + Tcl_Release(chanPtr); return copiedTotal; } @@ -4860,6 +4864,7 @@ Tcl_ReadRaw( * requests more bytes. */ + Tcl_Preserve(chanPtr); for (copied = 0; copied < bytesToRead; copied += copiedNow) { copiedNow = CopyBuffer(chanPtr, bufPtr + copied, bytesToRead - copied); @@ -4946,7 +4951,7 @@ Tcl_ReadRaw( * over EAGAIN/WOULDBLOCK handling. */ - return copied; + goto done; } SetFlag(statePtr, CHANNEL_BLOCKED); @@ -4954,14 +4959,17 @@ Tcl_ReadRaw( } Tcl_SetErrno(result); - return -1; + copied = -1; + goto done; } - return copied + nread; + copied += nread; + goto done; } } done: + Tcl_Release(chanPtr); return copied; } @@ -5069,6 +5077,7 @@ DoReadChars( chanPtr = statePtr->topChanPtr; encoding = statePtr->encoding; factor = UTF_EXPANSION_FACTOR; + Tcl_Preserve(chanPtr); if (appendFlag == 0) { if (encoding == NULL) { @@ -5158,6 +5167,7 @@ DoReadChars( done: UpdateInterest(chanPtr); + Tcl_Release(chanPtr); return copied; } @@ -7700,6 +7710,11 @@ UpdateInterest( /* State info for channel */ int mask = statePtr->interestMask; + if (chanPtr->typePtr == NULL) { + /* Do not update interest on a closed channel */ + return; + } + /* * If there are flushed buffers waiting to be written, then we need to * watch for the channel to become writable. @@ -8785,6 +8800,7 @@ DoRead( * operation. */ + Tcl_Preserve(chanPtr); if (!(statePtr->flags & CHANNEL_STICKY_EOF)) { ResetFlag(statePtr, CHANNEL_EOF); } @@ -8822,6 +8838,7 @@ DoRead( done: UpdateInterest(chanPtr); + Tcl_Release(chanPtr); return copied; } diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index ca3ab4b..affed02 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -571,6 +571,7 @@ TclChanCreateObjCmd( chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr, mode); rcPtr->chan = chan; + Tcl_Preserve(chan); chanPtr = (Channel *) chan; /* @@ -2145,6 +2146,7 @@ FreeReflectedChannel( ckfree((char*) chanPtr->typePtr); } + Tcl_Release(chanPtr); n = rcPtr->argc - 2; for (i=0; i<n; i++) { diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 768a748..bdf0fb3 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -1013,6 +1013,20 @@ test iocmd-23.10 {chan read, EAGAIN means no data, yet no eof either} -match glo rename foo {} unset res } -result {{read rc* 4096} {} 0} +test iocmd-23.11 {chan read, close pulls the rug out} -match glob -body { + set res {} + proc foo {args} { + oninit; onfinal; track + set args [lassign $args sub id] + if {$sub ne "read"} {return} + close $id + return {} + } + set c [chan create {r} foo] + note [read $c] + rename foo {} + set res +} -result {{read rc* 4096} {}} # --- === *** ########################### # method write diff --git a/tests/iogt.test b/tests/iogt.test index 3882ecc..d54ae04 100644 --- a/tests/iogt.test +++ b/tests/iogt.test @@ -242,6 +242,26 @@ proc id_fulltrail {var op data} { return $res } +proc id_torture {chan op data} { + switch -- $op { + create/write - + create/read - + delete/write - + delete/read - + clear_read {;#ignore} + flush/write - + flush/read - + write - + read { + testchannel unstack $chan + testchannel transform $chan \ + -command [namespace code [list id_torture $chan]] + return $data + } + query/maxRead {return -1} + } +} + proc counter {var op data} { variable $var upvar 0 $var n @@ -364,6 +384,10 @@ proc audit_flow {var -attach channel} { testchannel transform $channel -command [namespace code [list id_fulltrail $var]] } +proc torture {-attach channel} { + testchannel transform $channel -command [namespace code [list id_torture $channel]] +} + proc stopafter {var n -attach channel} { variable $var upvar 0 $var vn @@ -632,6 +656,15 @@ delete/read {} *ignored* flush/write {} {} delete/write {} *ignored*} +test iogt-2.4 {basic I/O, mixed trail} {testchannel} { + set fh [open $path(dummy) r] + torture -attach $fh + chan configure $fh -buffersize 2 + set x [read $fh] + testchannel unstack $fh + close $fh + set x +} {} test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \ {testchannel unknownFailure} { diff --git a/unix/Makefile.in b/unix/Makefile.in index c7caf5b..746abde 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -736,6 +736,9 @@ install-binaries: binaries @INSTALL_STUB_LIB@ ; \ fi @EXTRA_INSTALL_BINARIES@ + @echo "Installing pkg-config file to $(LIB_INSTALL_DIR)/pkgconfig/" + @mkdir -p $(LIB_INSTALL_DIR)/pkgconfig + @$(INSTALL_DATA) tcl.pc $(LIB_INSTALL_DIR)/pkgconfig/tcl.pc install-libraries: libraries $(INSTALL_TZDATA) install-msgs @for i in "$(INCLUDE_INSTALL_DIR)" "$(SCRIPT_INSTALL_DIR)"; \ @@ -905,7 +908,8 @@ clean: distclean: clean rm -rf Makefile config.status config.cache config.log tclConfig.sh \ - $(PACKAGE).* prototype tclConfig.h *.plist Tcl.framework + $(PACKAGE).* prototype tclConfig.h *.plist Tcl.framework \ + tcl.pc cd dltest ; $(MAKE) distclean depend: @@ -1657,7 +1661,7 @@ $(UNIX_DIR)/tclConfig.h.in: $(MAC_OSX_DIR)/configure cd $(MAC_OSX_DIR); autoheader; touch $@ EOLFIX=$(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl -dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(MAC_OSX_DIR)/configure genstubs +dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(MAC_OSX_DIR)/configure genstubs rm -rf $(DISTDIR) mkdir -p $(DISTDIR)/unix cp -p $(UNIX_DIR)/*.[ch] $(DISTDIR)/unix @@ -1668,7 +1672,7 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(MAC_OSX_DIR)/configure $(UNIX_DIR)/tclConfig.sh.in $(UNIX_DIR)/install-sh \ $(UNIX_DIR)/README $(UNIX_DIR)/ldAix $(UNIX_DIR)/tcl.spec \ $(UNIX_DIR)/installManPage $(UNIX_DIR)/tclConfig.h.in \ - $(DISTDIR)/unix + $(UNIX_DIR)/tcl.pc.in $(DISTDIR)/unix chmod 775 $(DISTDIR)/unix/configure $(DISTDIR)/unix/configure.in chmod 775 $(DISTDIR)/unix/ldAix @mkdir $(DISTDIR)/generic diff --git a/unix/configure b/unix/configure index 1b2ea41..02a3725 100755 --- a/unix/configure +++ b/unix/configure @@ -18915,7 +18915,7 @@ TCL_SHARED_BUILD=${SHARED_BUILD} - ac_config_files="$ac_config_files Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in" + ac_config_files="$ac_config_files Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in tcl.pc:../unix/tcl.pc.in" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure @@ -19469,6 +19469,7 @@ do "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile:../unix/Makefile.in" ;; "dltest/Makefile" ) CONFIG_FILES="$CONFIG_FILES dltest/Makefile:../unix/dltest/Makefile.in" ;; "tclConfig.sh" ) CONFIG_FILES="$CONFIG_FILES tclConfig.sh:../unix/tclConfig.sh.in" ;; + "tcl.pc" ) CONFIG_FILES="$CONFIG_FILES tcl.pc:../unix/tcl.pc.in" ;; "Tcl.framework" ) CONFIG_COMMANDS="$CONFIG_COMMANDS Tcl.framework" ;; *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 echo "$as_me: error: invalid argument: $ac_config_target" >&2;} diff --git a/unix/configure.in b/unix/configure.in index b5a09dd..318bcf8 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -940,5 +940,6 @@ AC_CONFIG_FILES([ Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in + tcl.pc:../unix/tcl.pc.in ]) AC_OUTPUT diff --git a/unix/tcl.pc.in b/unix/tcl.pc.in new file mode 100644 index 0000000..6b6fe44 --- /dev/null +++ b/unix/tcl.pc.in @@ -0,0 +1,15 @@ +# tcl pkg-config source file + +prefix=@prefix@ +exec_prefix=@exec_prefix@ +libdir=@libdir@ +includedir=@includedir@ + +Name: Tool Command Language +Description: Tcl is a powerful, easy-to-learn dynamic programming language, suitable for a wide range of uses. +URL: http://www.tcl.tk/ +Version: @TCL_VERSION@ +Requires: +Conflicts: +Libs: -L${libdir} @TCL_LIB_FLAG@ @TCL_LIBS@ +Cflags: -I${includedir} |