set ::tests_failed {}
proc assert {condition} {
- if {![uplevel 1 expr $condition]} {
- error "assertion:Expected '$value' to be true"
+ if {![uplevel 1 [list expr $condition]]} {
+ error "assertion:Expected condition '$condition' to be true ([uplevel 1 [list subst -nocommands $condition]])"
}
}
assert_equal $type [r type $key]
}
+# 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 {
incr ::num_tests
set details {}
- lappend details $::curfile
- lappend details $::tags
- lappend details $name
+ lappend details "$name in $::curfile"
- if {$::verbose} {
- puts -nonewline [format "#%03d %-68s " $::num_tests $name]
- flush stdout
- }
+ send_data_packet $::test_server_fd testing $name
if {[catch {set retval [uplevel 1 $code]} error]} {
if {[string match "assertion:*" $error]} {
lappend ::tests_failed $details
incr ::num_failed
- if {$::verbose} {
- puts "FAILED"
- puts "$msg\n"
- } else {
- puts -nonewline "F"
- }
+ send_data_packet $::test_server_fd err [join $details "\n"]
} else {
# Re-raise, let handler up the stack take care of this.
error $error $::errorInfo
} else {
if {$okpattern eq "undefined" || $okpattern eq $retval || [string match $okpattern $retval]} {
incr ::num_passed
- if {$::verbose} {
- puts "PASSED"
- } else {
- puts -nonewline "."
- }
+ send_data_packet $::test_server_fd ok $name
} else {
set msg "Expected '$okpattern' to equal or match '$retval'"
lappend details $msg
lappend ::tests_failed $details
incr ::num_failed
- if {$::verbose} {
- puts "FAILED"
- puts "$msg\n"
- } else {
- puts -nonewline "F"
- }
+ send_data_packet $::test_server_fd err [join $details "\n"]
}
}
- flush stdout
if {$::traceleaks} {
set output [exec leaks redis-server]
if {![string match {*0 leaks*} $output]} {
- puts "--- Test \"$name\" leaked! ---"
- puts $output
- exit 1
+ send_data_packet $::test_server_fd err "Detected a memory leak in test '$name': $output"
}
}
}