tests/support/test.tcl

   1 set ::passed 0
   2 set ::failed 0
   3 set ::testnum 0
   4
   5 proc test {name code okpattern} {
   6     incr ::testnum
   7     puts -nonewline [format "#%03d %-68s " $::testnum $name]
   8     flush stdout
   9     if {[catch {set retval [uplevel 1 $code]} error]} {
  10         puts "EXCEPTION"
  11         puts "\nCaught error: $error"
  12         error "exception"
  13     }
  14     if {$okpattern eq $retval || [string match $okpattern $retval]} {
  15         puts "PASSED"
  16         incr ::passed
  17     } else {
  18         puts "!! ERROR expected\n'$okpattern'\nbut got\n'$retval'"
  19         incr ::failed
  20     }
  21     if {$::traceleaks} {
  22         if {![string match {*0 leaks*} [exec leaks redis-server]]} {
  23             puts "--------- Test $::testnum LEAKED! --------"
  24             exit 1
  25         }
  26     }
  27 }