summaryrefslogtreecommitdiffstats
path: root/tests/trace.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/trace.test')
-rw-r--r--tests/trace.test66
1 files changed, 64 insertions, 2 deletions
diff --git a/tests/trace.test b/tests/trace.test
index 4d924e2..0f48dcf 100644
--- a/tests/trace.test
+++ b/tests/trace.test
@@ -10,14 +10,15 @@
#
# 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.62 2008/07/19 22:50:38 nijtmans Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testcmdtrace [llength [info commands testcmdtrace]]
testConstraint testevalobjv [llength [info commands testevalobjv]]
@@ -2560,8 +2561,69 @@ set base {
}
runbase {{- *} {-* *} {- *} {- *}} $base
+test trace-39 {bug #3484621: tracing Bc'ed commands} -setup {
+ set ::traceLog 0
+ set ::traceCalls 0
+ set ::bar [list 0 1 2 3]
+ set res {}
+ proc dotrace args {
+ incr ::traceLog
+ }
+ proc foo {} {
+ incr ::traceCalls
+ # choose a BC'ed command that is 'unlikely' to interfere with tcltest's
+ # internals
+ lset ::bar 1 2
+ }
+} -body {
+ foo
+ lappend res $::traceLog
+
+ trace add execution lset enter dotrace
+ foo
+ lappend res $::traceLog
+
+ trace remove execution lset enter dotrace
+ foo
+ lappend res $::traceLog
+
+ list $::traceCalls | {*}$res
+} -cleanup {
+ unset ::traceLog ::traceCalls ::bar res
+ rename dotrace {}
+ rename foo {}
+} -result {3 | 0 1 1}
+
+test trace-39.1 {bug #3485022: tracing Bc'ed commands} -setup {
+ set ::traceLog 0
+ set ::traceCalls 0
+ set res {}
+ proc dotrace args {
+ incr ::traceLog
+ }
+ proc foo {} {
+ incr ::traceCalls
+ string equal zip zap
+ }
+} -body {
+ foo
+ lappend res $::traceLog
+
+ trace add execution ::tcl::string::equal enter dotrace
+ foo
+ lappend res $::traceLog
+ trace remove execution tcl::string::equal enter dotrace
+ foo
+ lappend res $::traceLog
+ list $::traceCalls | {*}$res
+} -cleanup {
+ unset ::traceLog ::traceCalls res
+ rename dotrace {}
+ rename foo {}
+} -result {3 | 0 1 1}
+
# Delete procedures when done, so we don't clash with other tests
# (e.g. foobar will clash with 'unknown' tests).
catch {rename foobar {}}