From: tjj@thumper..bellcore.com (J Tim Jordan)
Subject: Regression test recorder now broken
Reply-To: tjj@nomas.bellcore.com (J Tim Jordan)
Organization: Bellcore MRE
Date: Mon, 28 Dec 92 17:05:27 GMT

In version tk1.4 I had written a couple of simple tcl procedures to 
tk so that as I used any tk application my actions would be recorded
in such a way that the replaying of my actions could be done by simply
sourcing a file. I used this to generate regression tests. But when
I left 1.4 and went to 2.3, I started getting the error:

can't read "tk_priv(relief)": no such element in array

This is how I built the recording of a button: 
($RFH points to a file which holds the output which can be replayed)

	rename button button.old
	proc button {w args} {
		eval button.old $w $args
		bind $w <Button-1> "+global RFH; puts \$RFH {{$w invoke}}; flush \$RFH"
	}

I changed this to test my hypothesis of the problem to:

	rename button button.old
	proc button {w args} {
		eval button.old $w $args
		bind $w <Button-1> "puts stdout got_here"
	}

and still got the error message. This use to be a very 
easy way of generating regression tests by simply having the 
user recreate the problem for me, record the steps and then
after the fix, rerun the test with the good data and simply 
add this to the stack of tests run nightly or a 
release time. As a work around I could go into all my
tcl code (which is a lot) and change button to button.regon
but there is no automatic way of doing this. Plus I use
to be able to run regression test on production code
with out worrying that I can be adding bugs to it. I really 
hate to loose my regression testing system. Does anybody 
know of any solutions?

Tim 

Here is the entire code which composed my regression testing.
To rerun a test I simply did a foreach loop on the output
and sent it to the application being tested with a small sleep
in the loop.

proc eos_init {} {
    global env
    set tt [catch {set env(EOS_RECORD)}]
    if {$tt == 0} {
	set rec [set env(EOS_RECORD)]
	if { $rec == "on" } {
	global RFH
	set time [exec date {+%y%m%d%H%M}]
	set fn REG/rec.$time
	set RFH [open $fn w+]
	puts $RFH {{global DIFF; set DIFF [open DIFF w+]}}
	bind . <Shift-Button-3> "puts $RFH {{#FINISHED}}"
	set resfn REG/res.$time
	global DIFF; set DIFF [open $resfn w+]
	proc bind.new {w args} {
		global RFH
		eval bind.old $w $args
		if { [llength $args] > 1} {
			set seq [lindex $args 0]
			set cmd [lindex $args 1]
			bind.old $w $seq "+global RFH; puts $RFH {{$cmd}} ; flush $RFH"
		}
	}
	rename bind bind.old
	rename bind.new bind
	proc radiobutton.new {w args} {
		eval radiobutton.old $w $args
		bind.old $w <Button-1> "+global RFH; puts \$RFH {{$w invoke}}; flush \$RFH"
	}
	rename radiobutton radiobutton.old
	rename radiobutton.new radiobutton
	rename button button.old
	proc button {w args} {
		eval button.old $w $args
#		bind.old $w <Button-1> "+global RFH; puts \$RFH {{$w invoke}}; flush \$RFH"
		bind.old $w <Button-1> "puts stdout got_here"
	}
	proc listbox.new {w args} {
		eval listbox.oldd $w $args
		bind.old $w <Shift-Button-2> "+global RFH; puts \$RFH {{puts \$DIFF \"\[listall $w \]\" ; flush \$DIFF}}; flush \$RFH;  puts \$DIFF \"\[listall $w \]\"; flush \$DIFF"
		set cmda [lindex [$w config -yscrollcommand] 4]
		set cmd [lindex $cmda 0]
		if {[string compare [info command $cmd] {}] == {} } {
			puts stderr "ERROR: The command \"$cmd\"
			does not exist yet."
			coredump
		} 
		while {[set cmdc [info cmdcount]; catch "rename $cmd $cmd.$cmdc" ] != 0} {}
		eval "proc $cmd {args} {
			global RFH
			eval $cmd.$cmdc \$args
			puts \$RFH \"{$w view \[lindex \$args 3\]}\"
			flush \$RFH
		}"
	}
	rename listbox listbox.oldd
	rename listbox.new listbox
	proc entry.new {w args} {
		eval entry.old $w $args
		bind.old $w <Shift-Button-2> "+global RFH; puts \$RFH {{puts \$DIFF \"\[$w get \]\" ; flush \$DIFF}}; flush \$RFH;  puts \$DIFF \"\[$w get \]\"; flush \$DIFF"
	}
	rename entry entry.old
	rename entry.new entry
    } }
}