From 86011ea4066f2ab0939bb04f67619c14d867d7b3 Mon Sep 17 00:00:00 2001
From: Miguel Sofer <miguel.sofer@gmail.com>
Date: Fri, 15 Jun 2007 18:14:13 +0000
Subject: 	* 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.

---
 ChangeLog        |  8 ++++++++
 tests/trace.test | 52 +++++++++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 59 insertions(+), 1 deletion(-)

diff --git a/ChangeLog b/ChangeLog
index 2e42b10..f1d502b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2007-06-15  Miguel Sofer  <msofer@users.sf.net>
+
+	* 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.
+
 2007-06-14  Miguel Sofer  <msofer@users.sf.net>
 
 	* generic/tclInt.decls:   Modif to the internals of TclObjInterpProc
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 {}}
-- 
cgit v0.12