diff options
author | dgp <dgp@users.sourceforge.net> | 2016-06-16 14:48:35 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2016-06-16 14:48:35 (GMT) |
commit | b700360ad9501defb0b1e2d86353ac8d0db8eef4 (patch) | |
tree | 8b3bcb3adb8bd2eb44bcf16bb091722274e03e9e /tests/trace.test | |
parent | c755ef08151343eb145710489f8c999edbef15ff (diff) | |
parent | 296aebbd6ee092a25741684fa37ee31ef5a3e222 (diff) | |
download | tcl-b700360ad9501defb0b1e2d86353ac8d0db8eef4.zip tcl-b700360ad9501defb0b1e2d86353ac8d0db8eef4.tar.gz tcl-b700360ad9501defb0b1e2d86353ac8d0db8eef4.tar.bz2 |
Merge up to the 8.6.0 release.
Diffstat (limited to 'tests/trace.test')
-rw-r--r-- | tests/trace.test | 66 |
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 {}} |