diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2009-12-07 15:08:46 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2009-12-07 15:08:46 (GMT) |
commit | f02342c0abbf0a641833353f729836274db3b80a (patch) | |
tree | 71a2fc12e21428f67108259ced4ec165a370fd99 /tests/error.test | |
parent | 0a1a1db5620ec53dd755544a21572bf4391b43ac (diff) | |
download | tcl-f02342c0abbf0a641833353f729836274db3b80a.zip tcl-f02342c0abbf0a641833353f729836274db3b80a.tar.gz tcl-f02342c0abbf0a641833353f729836274db3b80a.tar.bz2 |
Plug memory leak. [Bug 2910044]
Diffstat (limited to 'tests/error.test')
-rw-r--r-- | tests/error.test | 67 |
1 files changed, 66 insertions, 1 deletions
diff --git a/tests/error.test b/tests/error.test index f522008..8f0c0f0 100644 --- a/tests/error.test +++ b/tests/error.test @@ -11,14 +11,30 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: error.test,v 1.24 2009/11/16 18:00:11 dgp Exp $ +# RCS: @(#) $Id: error.test,v 1.25 2009/12/07 15:08:47 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 namespace import -force ::tcltest::* } +testConstraint memory [llength [info commands memory]] namespace eval ::tcl::test::error { +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}] + } +} proc foo {} { global errorInfo @@ -801,6 +817,55 @@ test error-20.2 {bad code value in on handler} -body { try { list a b c } on 34985723094872345 {} {} } -returnCodes error -match glob -result {bad code *} +test error-21.1 {memory leaks in try: Bug 2910044} memory { + leaktest { + try {string repeat x 10} on ok {} {} + } +} 0 +test error-21.2 {memory leaks in try: Bug 2910044} memory { + leaktest { + try {error [string repeat x 10]} on error {} {} + } +} 0 +test error-21.3 {memory leaks in try: Bug 2910044} memory { + leaktest { + try {throw FOO [string repeat x 10]} trap FOO {} {} + } +} 0 +test error-21.4 {memory leaks in try: Bug 2910044} memory { + leaktest { + try {string repeat x 10} + } +} 0 +test error-21.5 {memory leaks in try: Bug 2910044} memory { + leaktest { + try {string repeat x 10} on ok {} {} finally {string repeat y 10} + } +} 0 +test error-21.6 {memory leaks in try: Bug 2910044} memory { + leaktest { + try { + error [string repeat x 10] + } on error {} {} finally { + string repeat y 10 + } + } +} 0 +test error-21.7 {memory leaks in try: Bug 2910044} memory { + leaktest { + try { + throw FOO [string repeat x 10] + } trap FOO {} {} finally { + string repeat y 10 + } + } +} 0 +test error-21.8 {memory leaks in try: Bug 2910044} memory { + leaktest { + try {string repeat x 10} finally {string repeat y 10} + } +} 0 + # negative case try tests - bad "trap" handler # what is the effect if we attempt to trap an errorcode that is not a list? # nested try |