summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tclIO.c23
-rw-r--r--generic/tclIORChan.c2
-rw-r--r--tests/ioCmd.test14
-rw-r--r--tests/iogt.test33
-rw-r--r--unix/Makefile.in10
-rwxr-xr-xunix/configure3
-rw-r--r--unix/configure.in1
-rw-r--r--unix/tcl.pc.in15
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}