Added test from Bug #494348, but solution still far off.

FossilOrigin-Name: 9a1a314b56a8cde21b6a50d2376f1888f48ff040

2 files changed, 30 insertions, 1 deletions

diff --git a/ChangeLog b/ChangeLog
index 34a3b74..53ece91 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2002-01-03  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
+
+	* tests/basic.test (basic-39.4): Reproducable script from Bug #494348
+
 2002-01-02  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
 
 	* tests/util.test (Wrapper_Tcl_StringMatch,util-5.*): Rewrote so
diff --git a/tests/basic.test b/tests/basic.test
index 62248a5..251d82e 100644
--- a/tests/basic.test
+++ b/tests/basic.test
@@ -15,7 +15,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: basic.test,v 1.12 2001/09/20 01:02:20 hobbs Exp $
+# RCS: @(#) $Id: basic.test,v 1.13 2002/01/03 11:58:25 dkf Exp $
 #
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -495,7 +495,32 @@ test basic-39.2 {Tcl_CreateTrace, correct command and argc/argv arguments of tra
 test basic-39.3 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} {
     testcmdtrace deletetest {set stuff [info tclversion]}
 } $tclvers
+test basic-39.4 {Tcl_CreateTrace, check that tracing doesn't cause memory faults} {testcmdtrace knownBug} {
+    proc inst {args} {}
+    proc Something {} {inst}
+    proc Test {level} {
+	incr level 
+	puts "Test: level = $level"
+	#inst "a"
+	Something ;# you may call inst directly
+	if {$level == 1} {
+	    set instlist {1 2}
+	} else {
+	    set instlist {}
+	}
+	puts "instlist = /$instlist/"
+
+	foreach inst $instlist { 
+	    puts "inst = /$inst/" 
+	    Test $level 
+	}
+    }
 
+    testcmdtrace tracetest {Test 0}
+} {}
+catch {rename inst {}}
+catch {rename Test {}}
+catch {rename Something {}}
 
 test basic-40.1 {Tcl_DeleteTrace} {emptyTest} {
 } {}