diff options
author | dgp <dgp@users.sourceforge.net> | 2014-05-01 15:13:46 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2014-05-01 15:13:46 (GMT) |
commit | 7526dfb7b5a0389d1442df96f1cfb2b7173649ed (patch) | |
tree | fb22b91d4f6acc638d2a4d80366274d61b9bb7c9 /tests | |
parent | a2fb498f19ef2cc63056bb932b942f0c1c407e93 (diff) | |
parent | 09c394df7d97291aecb28a07a6c5de3f0814a341 (diff) | |
download | tcl-7526dfb7b5a0389d1442df96f1cfb2b7173649ed.zip tcl-7526dfb7b5a0389d1442df96f1cfb2b7173649ed.tar.gz tcl-7526dfb7b5a0389d1442df96f1cfb2b7173649ed.tar.bz2 |
merge trunk
Diffstat (limited to 'tests')
-rw-r--r-- | tests/ioCmd.test | 33 | ||||
-rw-r--r-- | tests/stringComp.test | 34 |
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 |