X-Git-Url: https://git.saurik.com/redis.git/blobdiff_plain/08b59207509ffe2c6938f7051ea786c66e7fa09d..0a546fc01758f9a9f8b2113764c2cf963df6ef20:/tests/support/test.tcl diff --git a/tests/support/test.tcl b/tests/support/test.tcl index 988189bf..e801e1f2 100644 --- a/tests/support/test.tcl +++ b/tests/support/test.tcl @@ -2,6 +2,13 @@ set ::passed 0 set ::failed 0 set ::testnum 0 +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'" @@ -17,7 +24,7 @@ proc assert_equal {expected value} { } proc assert_error {pattern code} { - if {[catch $code error]} { + if {[catch {uplevel 1 $code} error]} { assert_match $pattern $error } else { puts "!! ERROR\nExpected an error but nothing was catched" @@ -26,9 +33,14 @@ proc assert_error {pattern code} { } 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] + # Swapped out values don't have an encoding, so make sure that + # the value is swapped in before checking the encoding. + set dbg [r debug object $key] + while {[string match "* swapped at:*" $dbg]} { + r debug swapin $key + set dbg [r debug object $key] + } + assert_match "* encoding:$enc *" $dbg } proc assert_type {type key} { @@ -78,8 +90,10 @@ proc test {name code {okpattern notspecified}} { } } if {$::traceleaks} { - if {![string match {*0 leaks*} [exec leaks redis-server]]} { + set output [exec leaks redis-server] + if {![string match {*0 leaks*} $output]} { puts "--------- Test $::testnum LEAKED! --------" + puts $output exit 1 } }