summaryrefslogtreecommitdiffstats
path: root/tests/compile.test
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2001-10-12 16:13:32 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2001-10-12 16:13:32 (GMT)
commit47e03b582e130db6e8ff0cd8c3a8be4107ec1f3f (patch)
tree81a782ddf872be919bd77312fc6b191c6faf0b59 /tests/compile.test
parent2c479f513b6b833317db85405ef88db2ad109533 (diff)
downloadtcl-47e03b582e130db6e8ff0cd8c3a8be4107ec1f3f.zip
tcl-47e03b582e130db6e8ff0cd8c3a8be4107ec1f3f.tar.gz
tcl-47e03b582e130db6e8ff0cd8c3a8be4107ec1f3f.tar.bz2
* tests/compile.test: new tests for [Bug 467523]
Diffstat (limited to 'tests/compile.test')
-rw-r--r--tests/compile.test54
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}