summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2014-05-01 15:13:46 (GMT)
committerdgp <dgp@users.sourceforge.net>2014-05-01 15:13:46 (GMT)
commit7526dfb7b5a0389d1442df96f1cfb2b7173649ed (patch)
treefb22b91d4f6acc638d2a4d80366274d61b9bb7c9 /tests
parenta2fb498f19ef2cc63056bb932b942f0c1c407e93 (diff)
parent09c394df7d97291aecb28a07a6c5de3f0814a341 (diff)
downloadtcl-7526dfb7b5a0389d1442df96f1cfb2b7173649ed.zip
tcl-7526dfb7b5a0389d1442df96f1cfb2b7173649ed.tar.gz
tcl-7526dfb7b5a0389d1442df96f1cfb2b7173649ed.tar.bz2
merge trunk
Diffstat (limited to 'tests')
-rw-r--r--tests/ioCmd.test33
-rw-r--r--tests/stringComp.test34
2 files changed, 66 insertions, 1 deletions
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 36339ec..3976d25 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -844,6 +844,39 @@ test iocmd-21.22 {[close] in [read] segfaults} -setup {
catch {close $ch}
rename foo {}
} -match glob -result {*invalid argument*}
+test iocmd-21.23 {[close] in [gets] segfaults} -setup {
+ proc foo {method chan args} {
+ switch -- $method initialize {
+ return {initialize finalize watch read}
+ } finalize {} watch {} read {
+ catch {close $chan}
+ return \n
+ }
+ }
+ set ch [chan create read foo]
+} -body {
+ gets $ch
+} -cleanup {
+ catch {close $ch}
+ rename foo {}
+} -result {}
+test iocmd-21.24 {[close] in binary [gets] segfaults} -setup {
+ proc foo {method chan args} {
+ switch -- $method initialize {
+ return {initialize finalize watch read}
+ } finalize {} watch {} read {
+ catch {close $chan}
+ return \n
+ }
+ }
+ set ch [chan create read foo]
+} -body {
+ chan configure $ch -translation binary
+ gets $ch
+} -cleanup {
+ catch {close $ch}
+ rename foo {}
+} -result {}
# --- --- --- --------- --------- ---------
# Helper commands to record the arguments to handler methods.
diff --git a/tests/stringComp.test b/tests/stringComp.test
index 9e00ce7..165ef20 100644
--- a/tests/stringComp.test
+++ b/tests/stringComp.test
@@ -26,6 +26,22 @@ catch [list package require -exact Tcltest [info patchlevel]]
# Some tests require the testobj command
testConstraint testobj [expr {[info commands testobj] != {}}]
+testConstraint memory [llength [info commands memory]]
+if {[testConstraint memory]} {
+ proc getbytes {} {
+ set lines [split [memory info] \n]
+ return [lindex $lines 3 3]
+ }
+ proc leaktest {script {iterations 3}} {
+ set end [getbytes]
+ for {set i 0} {$i < $iterations} {incr i} {
+ uplevel 1 $script
+ set tmp $end
+ set end [getbytes]
+ }
+ return [expr {$end - $tmp}]
+ }
+}
test stringComp-1.1 {error conditions} {
proc foo {} {string gorp a b}
@@ -687,7 +703,23 @@ test stringComp-12.1 {Bug 3588366: end-offsets before start} {
## not yet bc
## string replace
-## not yet bc
+test stringComp-14.1 {Bug 82e7f67325} {
+ apply {x {
+ set a [join $x {}]
+ lappend b [string length [string replace ___! 0 2 $a]]
+ lappend b [string length [string replace ___! 0 2 $a[unset a]]]
+ }} {a b}
+} {3 3}
+test stringComp-14.2 {Bug 82e7f67325} memory {
+ # As in stringComp-14.1, but make sure we don't retain too many refs
+ leaktest {
+ apply {x {
+ set a [join $x {}]
+ lappend b [string length [string replace ___! 0 2 $a]]
+ lappend b [string length [string replace ___! 0 2 $a[unset a]]]
+ }} {a b}
+ }
+} {0}
## string tolower
## not yet bc