summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2002-01-03 18:23:47 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2002-01-03 18:23:47 (GMT)
commite9733d7e31787203d2e1ca47c8c05cc6669e2ad9 (patch)
tree4bea20379f2b8b069951068a3f9d76a1452a9309 /tests
parent4d95e01079a93133d207c23cd8ac9b6201bb557d (diff)
downloadtcl-e9733d7e31787203d2e1ca47c8c05cc6669e2ad9.zip
tcl-e9733d7e31787203d2e1ca47c8c05cc6669e2ad9.tar.gz
tcl-e9733d7e31787203d2e1ca47c8c05cc6669e2ad9.tar.bz2
Added fix for Bug #494348; the [foreach] implementation was doing some
cacheing that didn't seem to be safe, and which wouldn't gain very much performance either. Removing it fixed the bug.
Diffstat (limited to 'tests')
-rw-r--r--tests/basic.test39
1 files changed, 13 insertions, 26 deletions
diff --git a/tests/basic.test b/tests/basic.test
index 251d82e..f088b41 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.13 2002/01/03 11:58:25 dkf Exp $
+# RCS: @(#) $Id: basic.test,v 1.14 2002/01/03 18:23:47 dkf Exp $
#
if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -495,32 +495,19 @@ 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
- }
+test basic-39.4 {Tcl_CreateTrace, check that tracing doesn't cause memory faults} {testcmdtrace} {
+ # Note that the proc call is the same as the variable name, and that
+ # the call can be direct or indirect by way of another procedure
+ proc tracer {args} {}
+ proc tracedLoop {level} {
+ incr level
+ tracer
+ foreach tracer [expr {$level==1 ? {1 2} : {}}] {tracedLoop $level}
}
-
- testcmdtrace tracetest {Test 0}
-} {}
-catch {rename inst {}}
-catch {rename Test {}}
-catch {rename Something {}}
+ testcmdtrace tracetest {tracedLoop 0}
+} {{tracedLoop 0} {tracedLoop 0} {incr level} {incr level} tracer {tracer} {expr {$level==1 ? {1 2} : {}}} {expr {$level==1 ? {1 2} : {}}} {foreach tracer [expr {$level==1 ? {1 2} : {}}] {tracedLoop $level}} {foreach tracer {1 2} {tracedLoop $level}} {tracedLoop $level} {tracedLoop 1} {incr level} {incr level} tracer {tracer} {expr {$level==1 ? {1 2} : {}}} {expr {$level==1 ? {1 2} : {}}} {foreach tracer [expr {$level==1 ? {1 2} : {}}] {tracedLoop $level}} {foreach tracer {} {tracedLoop $level}} {tracedLoop $level} {tracedLoop 1} {incr level} {incr level} tracer {tracer} {expr {$level==1 ? {1 2} : {}}} {expr {$level==1 ? {1 2} : {}}} {foreach tracer [expr {$level==1 ? {1 2} : {}}] {tracedLoop $level}} {foreach tracer {} {tracedLoop $level}}}
+catch {rename tracer {}}
+catch {rename tracedLoop {}}
test basic-40.1 {Tcl_DeleteTrace} {emptyTest} {
} {}