#! /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
