results hook patch

[Ben Elliston]

The following patch, developed eons ago, might be useful to others.  I
use it to hook in my own procedures to perform actions when I get
passes, fails, etc. during test runs.  One idea is to play a sound
file when tests fail, so that you can monitor the progress from the
couch.  ;-)

For example, in my site.exp, I have:

    proc doh {msg} { exec play /usr/share/sounds/doh.wav }
    set local_record_procs(fail) doh

Ben


2001-01-15  Ben Elliston  <address@hidden>

        * lib/framework.exp (record_test): Invoke a user-defined procedure
        if one is named in local_record_procs($type).

--- framework.exp       2000/07/08 16:56:38     1.69
+++ framework.exp       2001/01/15 03:57:41     1.70
@@ -653,9 +653,19 @@ proc record_test { type message args } {
 
     global multipass_name
     if { $multipass_name != "" } {
-       clone_output "$type: $multipass_name: $message"
+       set message [format "$type: %s: $message" "$multipass_name"]
     } else {
-       clone_output "$type: $message"
+       set message "$type: $message"
+    }
+    clone_output "$message"
+
+    # If a command name exists in the $local_record_procs associative
+    # array for this type of result, then invoke it.
+
+    set lowcase_type [string tolower $type]
+    global local_record_procs
+    if {[info exists local_record_procs($lowcase_type)]} {
+       $local_record_procs($lowcase_type) "$message"
     }
     
     # Reset these so they're ready for the next test case.  We don't reset