X-Git-Url: https://git.saurik.com/redis.git/blobdiff_plain/eae9cce166dbb896eabda3c7bd37bd0bca0b2311..53f0efe28c4fe2f8d15286c02ccd2d83a5195fc9:/tests/support/test.tcl diff --git a/tests/support/test.tcl b/tests/support/test.tcl index c70cc049..724646a3 100644 --- a/tests/support/test.tcl +++ b/tests/support/test.tcl @@ -44,8 +44,22 @@ proc assert_type {type key} { assert_equal $type [r type $key] } +# This is called before starting the test +proc announce_test {s} { + if {[info exists ::env(TERM)] && [string match $::env(TERM) xterm]} { + puts -nonewline "$s\033\[0K" + flush stdout + set ::backward_count [string length $s] + } +} + +# This is called after the test finished proc colored_dot {tags passed} { if {[info exists ::env(TERM)] && [string match $::env(TERM) xterm]} { + # 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 @@ -69,7 +83,7 @@ proc colored_dot {tags passed} { if {$passed} { puts -nonewline "\033\[0;${colorcode};40m" } else { - puts -nonewline "\033\[0;40;${colorcode}m" + puts -nonewline "\033\[7;${colorcode};40m" } puts -nonewline $ch puts -nonewline "\033\[0m" @@ -115,6 +129,8 @@ proc test {name code {okpattern undefined}} { if {$::verbose} { puts -nonewline [format "#%03d %-68s " $::num_tests $name] flush stdout + } else { + announce_test $name } if {[catch {set retval [uplevel 1 $code]} error]} {