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]])"
}
}
expr {[info exists ::env(TERM)] && [string match *xterm* $::env(TERM)]}
}
-# This is called after the test finished
-proc colored_dot {tags passed} {
+proc colorstr {color str} {
if {[color_term]} {
- # Go backward and delete what announc_test function printed.
- puts -nonewline "\033\[${::backward_count}D\033\[0K\033\[J"
-
- # Print a coloured char, accordingly to test outcome and tags.
- if {[lsearch $tags list] != -1} {
- set colorcode {31}
- set ch L
- } elseif {[lsearch $tags hash] != -1} {
- set colorcode {32}
- set ch H
- } elseif {[lsearch $tags set] != -1} {
- set colorcode {33}
- set ch S
- } elseif {[lsearch $tags zset] != -1} {
- set colorcode {34}
- set ch Z
- } elseif {[lsearch $tags basic] != -1} {
- set colorcode {35}
- set ch B
- } else {
- set colorcode {37}
- set ch .
+ 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 {}} {
- if {$passed} {
- puts -nonewline "\033\[0;${colorcode};40m"
- } else {
- puts -nonewline "\033\[7;${colorcode};40m"
- }
- puts -nonewline $ch
- puts -nonewline "\033\[0m"
- flush stdout
+ return "\033\[$b;${colorcode};40m$str\033\[0m"
}
} else {
- if {$passed} {
- puts -nonewline .
- } else {
- puts -nonewline F
- }
+ return $str
}
}
incr ::num_tests
set details {}
- lappend details $::curfile
- lappend details $::tags
- lappend details $name
+ lappend details "$name in $::curfile"
send_data_packet $::test_server_fd testing $name
lappend ::tests_failed $details
incr ::num_failed
- send_data_packet $::test_server_fd err $name
+ 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
lappend ::tests_failed $details
incr ::num_failed
- send_data_packet $::test_server_fd err $name
+ send_data_packet $::test_server_fd err [join $details "\n"]
}
}