summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--changes39
-rw-r--r--generic/tclIO.c18
-rw-r--r--generic/tclOO.h2
-rw-r--r--tests/append.test17
-rw-r--r--tests/appendComp.test21
-rw-r--r--tests/interp.test4
-rw-r--r--tests/ioTrans.test6
-rw-r--r--tests/oo.test2
-rw-r--r--tests/ooNext2.test2
-rw-r--r--tests/parse.test8
-rw-r--r--tests/parseOld.test12
-rw-r--r--tests/socket.test2
-rw-r--r--tests/subst.test4
-rw-r--r--tests/utf.test40
-rw-r--r--unix/tclooConfig.sh2
-rw-r--r--win/tclooConfig.sh2
16 files changed, 137 insertions, 44 deletions
diff --git a/changes b/changes
index ba0854b..945b167 100644
--- a/changes
+++ b/changes
@@ -8452,3 +8452,42 @@ include ::oo::class (fellows)
2014-08-25 (TIP 429) New command [string cat] (leitgeb,ferrieux)
--- Released 8.6.2, August 27, 2014 --- http://core.tcl.tk/tcl/ for details
+
+2014-08-28 (bug)[b9e1a3] Correct Method Search Order (nadkarni,fellows)
+=> TclOO 1.0.3
+
+2014-09-05 (bug)[ccc2c2] Regression [lreplace {} 1 1] (bron,fellows)
+
+2014-09-08 (bug)<oo-1.18.2> Crash regression in [oo::class destroy] (porter)
+
+2014-09-09 (bug)[84af11] Regress [regsub -all {\(.*} a(b) {}] (fellows)
+
+2014-09-10 (bug)[cee90e] [try {} on ok {} - on return {} {}] panic (porter)
+
+2014-09-20 (feature) [tcl::unsupported::getbytecode] disassember (fellows)
+
+2014-09-27 (enhancement) [string cat] bytecode optimization (leitgeb,ferrieux)
+
+2014-09-27 (bug)[82521b] segfault in mangled bytecode (ogilvie,sofer)
+
+2014-10-02 (bug)[bc5b79] Hang in some [read]s of limited size (rogers,porter)
+
+2014-10-03 (bug)[bc1a96] segfault in [array set] of traced array (tab,porter)
+
+2014-10-08 (bug)[59a2e7] MSVC14 compile support (dower,nijtmans)
+
+2014-10-10 (bug)[ed29c4] [fcopy] treats [blocked] as error (rowen,porter)
+
+2014-10-10 (bug)[bf7135] regression in Tcl_Write() interface (porter)
+
+2014-10-18 (bug)[10dc6d] fix [gets] on non-blocking channels (fassel,porter)
+
+2014-10-26 Support for Windows 10 (nijtmans)
+
+2014-10-31 (bug)[dcc034] restore [open comX: r+] (lll,nijtmans)
+
+2014-11-05 (bug)[214cc0] Restore [lappend v] return value (sayers,porter)
+
+2014-11-06 (bug)[5adc35] Stop forcing EOF to be permanent (porter)
+
+--- Released 8.6.3, November 12, 2014 --- http://core.tcl.tk/tcl/ for details
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 74c7359..6f9dbfe 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -155,6 +155,7 @@ static ChannelBuffer * AllocChannelBuffer(int length);
static void PreserveChannelBuffer(ChannelBuffer *bufPtr);
static void ReleaseChannelBuffer(ChannelBuffer *bufPtr);
static int IsShared(ChannelBuffer *bufPtr);
+static void ChannelFree(Channel *chanPtr);
static void ChannelTimerProc(ClientData clientData);
static int ChanRead(Channel *chanPtr, char *dst, int dstSize);
static int CheckChannelErrors(ChannelState *statePtr,
@@ -1914,6 +1915,16 @@ TclChannelRelease(
}
}
+static void
+ChannelFree(
+ Channel *chanPtr)
+{
+ if (chanPtr->refCount == 0) {
+ ckfree(chanPtr);
+ return;
+ }
+ chanPtr->typePtr = NULL;
+}
/*
*----------------------------------------------------------------------
@@ -2060,7 +2071,7 @@ Tcl_UnstackChannel(
*/
result = ChanClose(chanPtr, interp);
- chanPtr->typePtr = NULL;
+ ChannelFree(chanPtr);
UpdateInterest(statePtr->topChanPtr);
@@ -3018,7 +3029,8 @@ CloseChannel(
statePtr->topChanPtr = downChanPtr;
downChanPtr->upChanPtr = NULL;
- chanPtr->typePtr = NULL;
+
+ ChannelFree(chanPtr);
return Tcl_Close(interp, (Tcl_Channel) downChanPtr);
}
@@ -3029,7 +3041,7 @@ CloseChannel(
* stack, make sure to free the ChannelState structure associated with it.
*/
- chanPtr->typePtr = NULL;
+ ChannelFree(chanPtr);
Tcl_EventuallyFree(statePtr, TCL_DYNAMIC);
diff --git a/generic/tclOO.h b/generic/tclOO.h
index be0e6c1..50cc413 100644
--- a/generic/tclOO.h
+++ b/generic/tclOO.h
@@ -24,7 +24,7 @@
* win/tclooConfig.sh
*/
-#define TCLOO_VERSION "1.0.2"
+#define TCLOO_VERSION "1.0.3"
#define TCLOO_PATCHLEVEL TCLOO_VERSION
#include "tcl.h"
diff --git a/tests/append.test b/tests/append.test
index 69c6381..8fa4e61 100644
--- a/tests/append.test
+++ b/tests/append.test
@@ -292,6 +292,23 @@ test append-9.3 {bug 3057639, append direct eval, read trace on non-existing env
} -cleanup {
unset -nocomplain ::env(__DUMMY__)
} -result {0 {new value}}
+
+test append-10.1 {Bug 214cc0eb22: lappend with no values} {
+ set lst "# 1 2 3"
+ [subst lappend] lst
+} "# 1 2 3"
+test append-10.2 {Bug 214cc0eb22: lappend with no values} -body {
+ set lst "1 \{ 2"
+ [subst lappend] lst
+} -returnCodes error -result {unmatched open brace in list}
+test append-10.3 {Bug 214cc0eb22: expanded lappend with no values} {
+ set lst "# 1 2 3"
+ [subst lappend] lst {*}[list]
+} "# 1 2 3"
+test append-10.4 {Bug 214cc0eb22: expanded lappend with no values} -body {
+ set lst "1 \{ 2"
+ [subst lappend] lst {*}[list]
+} -returnCodes error -result {unmatched open brace in list}
unset -nocomplain i x result y
catch {rename foo ""}
diff --git a/tests/appendComp.test b/tests/appendComp.test
index f85c3ba..bbf5f9c 100644
--- a/tests/appendComp.test
+++ b/tests/appendComp.test
@@ -438,6 +438,27 @@ test appendComp-9.3 {bug 3057639, append direct eval, read trace on non-existing
} -cleanup {
unset -nocomplain ::env(__DUMMY__)
} -result {0 {new value}}
+
+test appendComp-10.1 {Bug 214cc0eb22: lappend with no values} {
+ apply {lst {
+ lappend lst
+ }} "# 1 2 3"
+} "# 1 2 3"
+test appendComp-10.2 {Bug 214cc0eb22: lappend with no values} -body {
+ apply {lst {
+ lappend lst
+ }} "1 \{ 2"
+} -returnCodes error -result {unmatched open brace in list}
+test appendComp-10.3 {Bug 214cc0eb22: expanded lappend with no values} {
+ apply {lst {
+ lappend lst {*}[list]
+ }} "# 1 2 3"
+} "# 1 2 3"
+test appendComp-10.4 {Bug 214cc0eb22: expanded lappend with no values} -body {
+ apply {lst {
+ lappend lst {*}[list]
+ }} "1 \{ 2"
+} -returnCodes error -result {unmatched open brace in list}
catch {unset i x result y}
catch {rename foo ""}
diff --git a/tests/interp.test b/tests/interp.test
index ad99fac..4bc9fe2 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -3615,10 +3615,10 @@ test interp-38.3 {interp debug wrong args} -body {
} -returnCodes {
error
} -result {wrong # args: should be "interp debug path ?-frame ?bool??"}
-test interp-38.4 {interp debug basic setup} -body {
+test interp-38.4 {interp debug basic setup} -constraints {!singleTestInterp} -body {
interp debug {}
} -result {-frame 0}
-test interp-38.5 {interp debug basic setup} -body {
+test interp-38.5 {interp debug basic setup} -constraints {!singleTestInterp} -body {
interp debug {} -f
} -result {0}
test interp-38.6 {interp debug basic setup} -body {
diff --git a/tests/ioTrans.test b/tests/ioTrans.test
index aa2fbc7..e179eab 100644
--- a/tests/ioTrans.test
+++ b/tests/ioTrans.test
@@ -601,8 +601,8 @@ test iortrans-4.9 {chan read, gets, bug 2921116} -setup {
# Driver for a base channel that emits several short "files"
# with each terminated by a fleeting EOF
proc driver {cmd args} {
- variable buffer
- variable index
+ variable ::tcl::buffer
+ variable ::tcl::index
set chan [lindex $args 0]
switch -- $cmd {
initialize {
@@ -613,6 +613,8 @@ test iortrans-4.9 {chan read, gets, bug 2921116} -setup {
finalize {
if {![info exists index($chan)]} {return}
unset index($chan) buffer($chan)
+ array unset index
+ array unset buffer
return
}
watch {}
diff --git a/tests/oo.test b/tests/oo.test
index 2c189ca..5fa760b 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -7,7 +7,7 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require TclOO 1.0.1
+package require TclOO 1.0.3
package require tcltest 2
if {"::tcltest" in [namespace children]} {
namespace import -force ::tcltest::*
diff --git a/tests/ooNext2.test b/tests/ooNext2.test
index 9a63577..5ecd209 100644
--- a/tests/ooNext2.test
+++ b/tests/ooNext2.test
@@ -7,7 +7,7 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require TclOO 1.0.1
+package require TclOO 1.0.3
package require tcltest 2
if {"::tcltest" in [namespace children]} {
namespace import -force ::tcltest::*
diff --git a/tests/parse.test b/tests/parse.test
index fe6026d..5d8afeb 100644
--- a/tests/parse.test
+++ b/tests/parse.test
@@ -303,8 +303,10 @@ test parse-6.16 {ParseTokens procedure, backslash substitution} testparser {
testparser {\n\a\x7f} 0
} {- {\n\a\x7f} 1 word {\n\a\x7f} 3 backslash {\n} 0 backslash {\a} 0 backslash {\x7f} 0 {}}
test parse-6.17 {ParseTokens procedure, null characters} {testparser testbytestring} {
- testparser [testbytestring "foo\0zz"] 0
-} "- [testbytestring foo\0zz] 1 word [testbytestring foo\0zz] 3 text foo 0 text [testbytestring \0] 0 text zz 0 {}"
+ expr {[testparser [testbytestring "foo\0zz"] 0] eq
+"- [testbytestring foo\0zz] 1 word [testbytestring foo\0zz] 3 text foo 0 text [testbytestring \0] 0 text zz 0 {}"
+ }
+} 1
test parse-6.18 {ParseTokens procedure, seek past numBytes for close-bracket} testparser {
# Test for Bug 681841
list [catch {testparser {[a]} 2} msg] $msg
@@ -916,7 +918,7 @@ test parse-15.57 {CommandComplete procedure} {
test parse-15.58 {CommandComplete procedure, memory leaks} {
info complete "1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22"
} 1
-test parse-15.59 {CommandComplete procedure} {
+test parse-15.59 {CommandComplete procedure} testbytestring {
# Test for Tcl Bug 684744
info complete [testbytestring "\x00;if 1 \{"]
} 0
diff --git a/tests/parseOld.test b/tests/parseOld.test
index 4c08b5d..a6e07a2b 100644
--- a/tests/parseOld.test
+++ b/tests/parseOld.test
@@ -263,14 +263,14 @@ test parseOld-7.11 {backslash substitution} {
eval "list a \"b c\"\\\nd e"
} {a {b c} d e}
test parseOld-7.12 {backslash substitution} testbytestring {
- list \ua2
-} [testbytestring "\xc2\xa2"]
+ expr {[list \ua2] eq [testbytestring "\xc2\xa2"]}
+} 1
test parseOld-7.13 {backslash substitution} testbytestring {
- list \u4e21
-} [testbytestring "\xe4\xb8\xa1"]
+ expr {[list \u4e21] eq [testbytestring "\xe4\xb8\xa1"]}
+} 1
test parseOld-7.14 {backslash substitution} testbytestring {
- list \u4e2k
-} [testbytestring "\xd3\xa2k"]
+ expr {[list \u4e2k] eq [testbytestring "\xd3\xa2k"]}
+} 1
# Semi-colon.
diff --git a/tests/socket.test b/tests/socket.test
index d6cee30..eeea044 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -2249,7 +2249,7 @@ test socket-14.11.0 {pending [socket -async] and nonblocking [puts], no listener
unset x
} -result {socket is not connected} -returnCodes 1
test socket-14.11.1 {pending [socket -async] and nonblocking [puts], no listener, flush} \
- -constraints {socket} \
+ -constraints {socket nonportable} \
-body {
set sock [socket -async localhost [randport]]
fconfigure $sock -blocking 0
diff --git a/tests/subst.test b/tests/subst.test
index 256b7f7..2115772 100644
--- a/tests/subst.test
+++ b/tests/subst.test
@@ -38,8 +38,8 @@ test subst-2.3 {simple strings} {
} abcdefg
test subst-2.4 {simple strings} testbytestring {
# Tcl Bug 685106
- subst [testbytestring bar\x00soom]
-} [testbytestring bar\x00soom]
+ expr {[subst [testbytestring bar\x00soom]] eq [testbytestring bar\x00soom]}
+} 1
test subst-3.1 {backslash substitutions} {
subst {\x\$x\[foo bar]\\}
diff --git a/tests/utf.test b/tests/utf.test
index 83daddf..ceb1af7 100644
--- a/tests/utf.test
+++ b/tests/utf.test
@@ -21,23 +21,23 @@ testConstraint testbytestring [llength [info commands testbytestring]]
catch {unset x}
test utf-1.1 {Tcl_UniCharToUtf: 1 byte sequences} testbytestring {
- set x \x01
-} [testbytestring "\x01"]
+ expr {"\x01" eq [testbytestring "\x01"]}
+} 1
test utf-1.2 {Tcl_UniCharToUtf: 2 byte sequences} testbytestring {
- set x "\x00"
-} [testbytestring "\xc0\x80"]
+ expr {"\x00" eq [testbytestring "\xc0\x80"]}
+} 1
test utf-1.3 {Tcl_UniCharToUtf: 2 byte sequences} testbytestring {
- set x "\xe0"
-} [testbytestring "\xc3\xa0"]
+ expr {"\xe0" eq [testbytestring "\xc3\xa0"]}
+} 1
test utf-1.4 {Tcl_UniCharToUtf: 3 byte sequences} testbytestring {
- set x "\u4e4e"
-} [testbytestring "\xe4\xb9\x8e"]
+ expr {"\u4e4e" eq [testbytestring "\xe4\xb9\x8e"]}
+} 1
test utf-1.5 {Tcl_UniCharToUtf: overflowed Tcl_UniChar} testbytestring {
- format %c 0x110000
-} [testbytestring "\xef\xbf\xbd"]
+ expr {[format %c 0x110000] eq [testbytestring "\xef\xbf\xbd"]}
+} 1
test utf-1.6 {Tcl_UniCharToUtf: negative Tcl_UniChar} testbytestring {
- format %c -1
-} [testbytestring "\xef\xbf\xbd"]
+ expr {[format %c -1] eq [testbytestring "\xef\xbf\xbd"]}
+} 1
test utf-2.1 {Tcl_UtfToUniChar: low ascii} {
string length "abc"
@@ -128,17 +128,17 @@ test utf-10.1 {Tcl_UtfBackslash: dst == NULL} {
} {
}
test utf-10.2 {Tcl_UtfBackslash: \u subst} testbytestring {
- set x \ua2
-} [testbytestring "\xc2\xa2"]
+ expr {"\ua2" eq [testbytestring "\xc2\xa2"]}
+} 1
test utf-10.3 {Tcl_UtfBackslash: longer \u subst} testbytestring {
- set x \u4e21
-} [testbytestring "\xe4\xb8\xa1"]
+ expr {"\u4e21" eq [testbytestring "\xe4\xb8\xa1"]}
+} 1
test utf-10.4 {Tcl_UtfBackslash: stops at first non-hex} testbytestring {
- set x \u4e2k
-} "[testbytestring \xd3\xa2]k"
+ expr {"\u4e2k" eq "[testbytestring \xd3\xa2]k"}
+} 1
test utf-10.5 {Tcl_UtfBackslash: stops after 4 hex chars} testbytestring {
- set x \u4e216
-} "[testbytestring \xe4\xb8\xa1]6"
+ expr {"\u4e216" eq "[testbytestring \xe4\xb8\xa1]6"}
+} 1
proc bsCheck {char num} {
global errNum
test utf-10.$errNum {backslash substitution} {
diff --git a/unix/tclooConfig.sh b/unix/tclooConfig.sh
index 14b0d8d..55fe75f 100644
--- a/unix/tclooConfig.sh
+++ b/unix/tclooConfig.sh
@@ -16,4 +16,4 @@ TCLOO_STUB_LIB_SPEC=""
TCLOO_INCLUDE_SPEC=""
TCLOO_PRIVATE_INCLUDE_SPEC=""
TCLOO_CFLAGS=""
-TCLOO_VERSION=1.0.2
+TCLOO_VERSION=1.0.3
diff --git a/win/tclooConfig.sh b/win/tclooConfig.sh
index 14b0d8d..55fe75f 100644
--- a/win/tclooConfig.sh
+++ b/win/tclooConfig.sh
@@ -16,4 +16,4 @@ TCLOO_STUB_LIB_SPEC=""
TCLOO_INCLUDE_SPEC=""
TCLOO_PRIVATE_INCLUDE_SPEC=""
TCLOO_CFLAGS=""
-TCLOO_VERSION=1.0.2
+TCLOO_VERSION=1.0.3
generated by cgit v0.12 at 2025-12-25 00:09:30 (GMT)