Attachment "interferenceTest.tcl" to
ticket [1458266fff]
added by
eriklns
2006-04-02 18:01:24.
#! /bin/sh
# If executed as a shell script, the next line replaces the shell with wish \
exec tclsh "$0" ${1+"$@"}
package require tcltest 2.2
namespace import -force tcltest::*
tcltest::configure -verbose {body pass error}
# Test for bug report #1458266, against Tcl8.4.12
#
# The essence of this test is to check whether a command trace that occurs
# inside a step trace handler, re-enables further step tracing.
#
# The test exercises a particular corner case which occurs when:
# - a step type execution trace is registered on two different commands
# - both commands use the same step trace handler
# - the step trace handler executes a command trace handler (non-step)
# before it calls the proc that triggered the step trace handler in the
# first place.
#
# The command triggering a command trace is [clock]. This choice
# is arbitrary as long that command does not have any step traces
# registered on it, and its trace handler does not invoke further tracing.
#
# Because both commands use the same step trace handler, we're exercising
# a corner case about which the documentation is not explicit. Therefore,
# this test does not check for a predefined, hard coded result, but checks
# for differences between two runs: a differential diagnostic.
#
# The test consists of two runs which both store the traces that have been
# triggered:
# * Run 1: there is no trace on [clock]
# * Run 2: there is a command trace on [clock]
#
# There should be no difference in the traces triggered by the two runs.
# This is being checked by comparing the lists of stored traces produced
# by both runs.
#
test traceInterference-1.1 {cmd traces don't interfere with step traces} -body {
#
# This trace handler invokes the command which triggered the
# trace handler in the first place. According to the man page
# that should not lead to further triggers of the trace.
#
proc stepTraceHandler {cmdString args} {
global run traceList
# store stack level and command that triggered the trace
lappend traceList($run) [expr {[info level] -1}] [lindex [split $cmdString] 0]
# Bug #1458266, against Tcl8.4.12
#
# Executing an arbitrary command, which has a plain execution trace
# on it (not a step trace), re-enables further step tracing.
clock clicks
# If step tracing is re-enabled, the following command will be
# traced inside (which the docs forbid).
isTracedInside_2
}
# define trace handlers
proc cmdTraceHandler {cmdString args} {
# be quiet
}
proc isTracedInside_1 {} {
isTracedInside_2
}
proc isTracedInside_2 {} {
set x 1; # arbitrary command, triggering a step trace
}
# register step traces for both runs
trace add execution isTracedInside_1 enterstep stepTraceHandler
trace add execution isTracedInside_2 enterstep stepTraceHandler
# initiate Run1, no command trace on [clock]
set run 1
isTracedInside_1
# initiate Run2, registering a command trace on [clock]
set run 2
trace add execution clock enter cmdTraceHandler
isTracedInside_1
# Compare the trace lists generated by the two runs,
# and set an error flag if there are differences.
set errFlag 0
foreach run [list 1 2] {
set nElem($run) [llength $traceList($run)]
}
if {$nElem(1) != $nElem(2)} {
set errFlag 1
}
for {set i 1} {$i < $nElem(1)} {incr i} {
if {[lindex $traceList(1) $i] != [lindex $traceList(2) $i]} {
set errFlag 1
}
}
# if there are differences, write a table of the traces
# for the two runs to stderr.
if {$errFlag} {
puts stderr "Execution of a cmd trace inside a step trace handler caused Run 1 and Run 2 to trigger different traces"
foreach run [list 1 2] {
puts stderr "\n* Run $run:"
puts stderr "level\tcommand"
puts stderr [string repeat "-" 25]
foreach {level cmd} $traceList($run) {
puts stderr "$level\t$cmd"
}
}
}
} -result "" -errorOutput ""
# show results
tcltest::cleanupTests
