* generic/trace.test: added tests 36.* for dynamic trace creation

	and addition. These tests expose a change in dynamics due to a
	recent round of optimisations. The "correct" behaviour is not
	described in docs nor TIP 62. Currently test 36.2 fails, the opts
	will be rolled back.

1 files changed, 51 insertions, 1 deletions

diff --git a/tests/trace.test b/tests/trace.test
index f549a4b..539188e 100644
--- a/tests/trace.test
+++ b/tests/trace.test
@@ -11,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: trace.test,v 1.52 2007/06/12 12:34:04 dkf Exp $
+# RCS: @(#) $Id: trace.test,v 1.53 2007/06/15 18:14:14 msofer Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -2465,6 +2465,56 @@ test trace-35.1 {527164: Keep -errorinfo of traces} -setup {
 "set y 1"}}
 
 
+#
+# Test for the correct(?) dynamics of execution traces. This test insures that
+# the dynamics of the original implementation remain valid; note that
+# these aspects are neither documented nor do they appear in TIP 62
+
+proc traceproc {tracevar args} {
+    append ::$tracevar *
+}
+proc untraced {type} {
+    trace add execution untraced $type {traceproc tracevar}
+    append ::tracevar -
+}
+
+set base {
+    test trace-36.%N% {dynamic trace creation: %T%} -setup {
+	set ::tracevar {}
+    } -cleanup {
+	unset ::tracevar
+	trace remove execution untraced %T% {traceproc tracevar}
+    } -body {
+	untraced %T%
+	set ::tracevar
+    } -result %R%
+}
+
+foreach n {
+    1 2 3 4
+} t {
+    enter leave enterstep leavestep
+} r {
+    - -* - - 
+} {
+    set smap [list %N% $n %T% $t %R% $r]
+    eval [string map $smap $base]
+}
+
+test trace-36.5 {dynamic trace addition} -setup {
+    set ::tracevar {}
+    set ::tracevar2 {}
+    trace add execution untraced leave {traceproc tracevar2}
+} -cleanup {
+    trace remove execution untraced leave {traceproc tracevar}
+    trace remove execution untraced leave {traceproc tracevar2}
+} -body {
+    untraced leave
+    list $::tracevar $::tracevar2
+} -result {-* *}
+    
+
+
 # Delete procedures when done, so we don't clash with other tests
 # (e.g. foobar will clash with 'unknown' tests).
 catch {rename foobar {}}