From 4d95e01079a93133d207c23cd8ac9b6201bb557d Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 3 Jan 2002 11:58:24 +0000 Subject: Added test from Bug #494348, but solution still far off. --- ChangeLog | 4 ++++ tests/basic.test | 27 ++++++++++++++++++++++++++- 2 files changed, 30 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index 34a3b74..53ece91 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2002-01-03 Donal K. Fellows + + * tests/basic.test (basic-39.4): Reproducable script from Bug #494348 + 2002-01-02 Donal K. Fellows * 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} { } {} -- cgit v0.12