diff options
Diffstat (limited to 'tests/compile.test')
| -rw-r--r-- | tests/compile.test | 54 |
1 files changed, 52 insertions, 2 deletions
diff --git a/tests/compile.test b/tests/compile.test index 5e81a5c..ae3bfd4 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -1,4 +1,5 @@ -# This file contains tests for the files tclCompile.c and tclCompCmds.c +# This file contains tests for the files tclCompile.c, tclCompCmds.c +# and tclLiteral.c # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and @@ -10,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: compile.test,v 1.11 2001/08/31 17:53:57 hobbs Exp $ +# RCS: @(#) $Id: compile.test,v 1.12 2001/10/12 16:13:32 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -239,6 +240,55 @@ test compile-11.9 {Tcl_Append*: ensure Tcl_ResetResult is used properly} { list [catch {p} msg] $msg } {1 {unmatched open brace in list}} +# +# Special section for tests of tclLiteral.c +# The following tests check for incorrect memory handling in +# TclReleaseLiteral. They are only effective when tcl is compiled +# with TCL_MEM_DEBUG +# +# Special test for leak on interp delete [Bug 467523]. +test compile-12.1 {testing literal leak on interp delete} { + if {[llength [info commands memory]]} { + proc getbytes {} { + set lines [split [memory info] "\n"] + lindex [lindex $lines 3] 3 + } + + set end [getbytes] + for {set i 0} {$i < 5} {incr i} { + interp create foo + foo eval { + namespace eval bar {} + } + interp delete foo + set tmp $end + set end [getbytes] + } + + set leak [expr {$end - $tmp}] + rename getbytes {} + } else { + set leak 0 + } + set leak +} 0 +# Special test for a memory error in a preliminary fix of [Bug 467523]. +# It requires executing a helpfile +test compile-12.2 {testing error on literal deletion} { + makeFile { + for {set i 0} {$i < 5} {incr i} { + namespace eval bar {} + namespace delete bar + } + puts 0 + } source.file + set res [catch { + exec [info nameofexecutable] source.file + }] + catch {::tcltest::removeFile source.file} + set res +} 0 + # cleanup catch {rename p ""} catch {namespace delete test_ns_compile} |