-set ::passed 0
-set ::failed 0
-set ::testnum 0
+set ::num_tests 0
+set ::num_passed 0
+set ::num_failed 0
+set ::tests_failed {}
proc assert {condition} {
if {![uplevel 1 expr $condition]} {
- puts "!! ERROR\nExpected '$value' to evaluate to true"
- error "assertion"
+ error "assertion:Expected condition '$condition' to be true"
}
}
proc assert_match {pattern value} {
if {![string match $pattern $value]} {
- puts "!! ERROR\nExpected '$value' to match '$pattern'"
- error "assertion"
+ error "assertion:Expected '$value' to match '$pattern'"
}
}
proc assert_equal {expected value} {
if {$expected ne $value} {
- puts "!! ERROR\nExpected '$value' to be equal to '$expected'"
- error "assertion"
+ error "assertion:Expected '$value' to be equal to '$expected'"
}
}
if {[catch {uplevel 1 $code} error]} {
assert_match $pattern $error
} else {
- puts "!! ERROR\nExpected an error but nothing was catched"
- error "assertion"
+ error "assertion:Expected an error but nothing was catched"
}
}
assert_equal $type [r type $key]
}
-proc test {name code {okpattern notspecified}} {
+# Test if TERM looks like to support colors
+proc color_term {} {
+ expr {[info exists ::env(TERM)] && [string match *xterm* $::env(TERM)]}
+}
+
+proc colorstr {color str} {
+ if {[color_term]} {
+ set b 0
+ if {[string range $color 0 4] eq {bold-}} {
+ set b 1
+ set color [string range $color 5 end]
+ }
+ switch $color {
+ red {set colorcode {31}}
+ green {set colorcode {32}}
+ yellow {set colorcode {33}}
+ blue {set colorcode {34}}
+ magenta {set colorcode {35}}
+ cyan {set colorcode {36}}
+ white {set colorcode {37}}
+ default {set colorcode {37}}
+ }
+ if {$colorcode ne {}} {
+ return "\033\[$b;${colorcode};40m$str\033\[0m"
+ }
+ } else {
+ return $str
+ }
+}
+
+proc test {name code {okpattern undefined}} {
# abort if tagged with a tag to deny
foreach tag $::denytags {
if {[lsearch $::tags $tag] >= 0} {
}
}
- incr ::testnum
- puts -nonewline [format "#%03d %-68s " $::testnum $name]
- flush stdout
+ incr ::num_tests
+ set details {}
+ lappend details "$name in $::curfile"
+
+ send_data_packet $::test_server_fd testing $name
+
if {[catch {set retval [uplevel 1 $code]} error]} {
- if {$error eq "assertion"} {
- incr ::failed
+ if {[string match "assertion:*" $error]} {
+ set msg [string range $error 10 end]
+ lappend details $msg
+ lappend ::tests_failed $details
+
+ incr ::num_failed
+ send_data_packet $::test_server_fd err [join $details "\n"]
} else {
- puts "EXCEPTION"
- puts "\nCaught error: $error"
- error "exception"
+ # Re-raise, let handler up the stack take care of this.
+ error $error $::errorInfo
}
} else {
- if {$okpattern eq "notspecified" || $okpattern eq $retval || [string match $okpattern $retval]} {
- puts "PASSED"
- incr ::passed
+ if {$okpattern eq "undefined" || $okpattern eq $retval || [string match $okpattern $retval]} {
+ incr ::num_passed
+ send_data_packet $::test_server_fd ok $name
} else {
- puts "!! ERROR expected\n'$okpattern'\nbut got\n'$retval'"
- incr ::failed
+ set msg "Expected '$okpattern' to equal or match '$retval'"
+ lappend details $msg
+ lappend ::tests_failed $details
+
+ incr ::num_failed
+ send_data_packet $::test_server_fd err [join $details "\n"]
}
}
+
if {$::traceleaks} {
- if {![string match {*0 leaks*} [exec leaks redis-server]]} {
- puts "--------- Test $::testnum LEAKED! --------"
- exit 1
+ set output [exec leaks redis-server]
+ if {![string match {*0 leaks*} $output]} {
+ send_data_packet $::test_server_fd err "Detected a memory leak in test '$name': $output"
}
}
}