Attachment "leak.tests" to
ticket [467523ffff]
added by
msofer
2001-10-12 23:15:28.
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.658
diff -u -r1.658 ChangeLog
--- ChangeLog 2001/10/11 22:28:01 1.658
+++ ChangeLog 2001/10/12 16:11:33
@@ -1,3 +1,8 @@
+2001-10-12 Miguel Sofer <[email protected]>
+
+ * tests/compile.test: new tests for [Bug 467523]; they are only
+ effective if TCL_MEM_DEBUG was set during compilation.
+
2001-10-11 Miguel Sofer <[email protected]>
* generic/tclLiteral.c: (TclReleaseLiteral) insured that
Index: tests/compile.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/compile.test,v
retrieving revision 1.11
diff -u -r1.11 compile.test
--- tests/compile.test 2001/08/31 17:53:57 1.11
+++ tests/compile.test 2001/10/12 16:11:34
@@ -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
@@ -238,6 +239,55 @@
proc p {} { set r [list foobar] ; llength "\{" }
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 ""}
