X-Git-Url: https://git.saurik.com/redis.git/blobdiff_plain/9fcfd6b6512dd975ba3eadf476b7d5670c9dbb79..d9e28bcf00a1e52c5e0c8cbc5f2c8c8cb7d7027f:/tests/support/test.tcl?ds=sidebyside diff --git a/tests/support/test.tcl b/tests/support/test.tcl index d2674da1..2c1fc164 100644 --- a/tests/support/test.tcl +++ b/tests/support/test.tcl @@ -2,7 +2,47 @@ set ::passed 0 set ::failed 0 set ::testnum 0 -proc test {name code okpattern} { +proc assert {condition} { + if {![uplevel 1 expr $condition]} { + puts "!! ERROR\nExpected '$value' to evaluate to true" + error "assertion" + } +} + +proc assert_match {pattern value} { + if {![string match $pattern $value]} { + puts "!! ERROR\nExpected '$value' to match '$pattern'" + error "assertion" + } +} + +proc assert_equal {expected value} { + if {$expected ne $value} { + puts "!! ERROR\nExpected '$value' to be equal to '$expected'" + error "assertion" + } +} + +proc assert_error {pattern code} { + if {[catch {uplevel 1 $code} error]} { + assert_match $pattern $error + } else { + puts "!! ERROR\nExpected an error but nothing was catched" + error "assertion" + } +} + +proc assert_encoding {enc key} { + # swapped out value doesn't have encoding, so swap in first + r debug swapin $key + assert_match "* encoding:$enc *" [r debug object $key] +} + +proc assert_type {type key} { + assert_equal $type [r type $key] +} + +proc test {name code {okpattern notspecified}} { # abort if tagged with a tag to deny foreach tag $::denytags { if {[lsearch $::tags $tag] >= 0} { @@ -28,16 +68,21 @@ proc test {name code okpattern} { puts -nonewline [format "#%03d %-68s " $::testnum $name] flush stdout if {[catch {set retval [uplevel 1 $code]} error]} { - puts "EXCEPTION" - puts "\nCaught error: $error" - error "exception" - } - if {$okpattern eq $retval || [string match $okpattern $retval]} { - puts "PASSED" - incr ::passed + if {$error eq "assertion"} { + incr ::failed + } else { + puts "EXCEPTION" + puts "\nCaught error: $error" + error "exception" + } } else { - puts "!! ERROR expected\n'$okpattern'\nbut got\n'$retval'" - incr ::failed + if {$okpattern eq "notspecified" || $okpattern eq $retval || [string match $okpattern $retval]} { + puts "PASSED" + incr ::passed + } else { + puts "!! ERROR expected\n'$okpattern'\nbut got\n'$retval'" + incr ::failed + } } if {$::traceleaks} { if {![string match {*0 leaks*} [exec leaks redis-server]]} {