tests/support/test.tcl

   1 set ::num_tests 0
   2 set ::num_passed 0
   3 set ::num_failed 0
   4 set ::tests_failed {}
   5
   6 proc assert {condition} {
   7     if {![uplevel 1 expr $condition]} {
   8         error "assertion:Expected '$value' to be true"
   9     }
  10 }
  11
  12 proc assert_match {pattern value} {
  13     if {![string match $pattern $value]} {
  14         error "assertion:Expected '$value' to match '$pattern'"
  15     }
  16 }
  17
  18 proc assert_equal {expected value} {
  19     if {$expected ne $value} {
  20         error "assertion:Expected '$value' to be equal to '$expected'"
  21     }
  22 }
  23
  24 proc assert_error {pattern code} {
  25     if {[catch {uplevel 1 $code} error]} {
  26         assert_match $pattern $error
  27     } else {
  28         error "assertion:Expected an error but nothing was catched"
  29     }
  30 }
  31
  32 proc assert_encoding {enc key} {
  33     # Swapped out values don't have an encoding, so make sure that
  34     # the value is swapped in before checking the encoding.
  35     set dbg [r debug object $key]
  36     while {[string match "* swapped at:*" $dbg]} {
  37         r debug swapin $key
  38         set dbg [r debug object $key]
  39     }
  40     assert_match "* encoding:$enc *" $dbg
  41 }
  42
  43 proc assert_type {type key} {
  44     assert_equal $type [r type $key]
  45 }
  46
  47 proc test {name code {okpattern undefined}} {
  48     # abort if tagged with a tag to deny
  49     foreach tag $::denytags {
  50         if {[lsearch $::tags $tag] >= 0} {
  51             return
  52         }
  53     }
  54
  55     # check if tagged with at least 1 tag to allow when there *is* a list
  56     # of tags to allow, because default policy is to run everything
  57     if {[llength $::allowtags] > 0} {
  58         set matched 0
  59         foreach tag $::allowtags {
  60             if {[lsearch $::tags $tag] >= 0} {
  61                 incr matched
  62             }
  63         }
  64         if {$matched < 1} {
  65             return
  66         }
  67     }
  68
  69     incr ::num_tests
  70     set details {}
  71     lappend details $::curfile
  72     lappend details $::tags
  73     lappend details $name
  74
  75     if {$::verbose} {
  76         puts -nonewline [format "#%03d %-68s " $::num_tests $name]
  77         flush stdout
  78     }
  79
  80     if {[catch {set retval [uplevel 1 $code]} error]} {
  81         if {[string match "assertion:*" $error]} {
  82             set msg [string range $error 10 end]
  83             lappend details $msg
  84             lappend ::tests_failed $details
  85
  86             incr ::num_failed
  87             if {$::verbose} {
  88                 puts "FAILED"
  89                 puts "$msg\n"
  90             } else {
  91                 puts -nonewline "F"
  92             }
  93         } else {
  94             # Re-raise, let handler up the stack take care of this.
  95             error $error $::errorInfo
  96         }
  97     } else {
  98         if {$okpattern eq "undefined" || $okpattern eq $retval || [string match $okpattern $retval]} {
  99             incr ::num_passed
 100             if {$::verbose} {
 101                 puts "PASSED"
 102             } else {
 103                 puts -nonewline "."
 104             }
 105         } else {
 106             set msg "Expected '$okpattern' to equal or match '$retval'"
 107             lappend details $msg
 108             lappend ::tests_failed $details
 109
 110             incr ::num_failed
 111             if {$::verbose} {
 112                 puts "FAILED"
 113                 puts "$msg\n"
 114             } else {
 115                 puts -nonewline "F"
 116             }
 117         }
 118     }
 119     flush stdout
 120
 121     if {$::traceleaks} {
 122         set output [exec leaks redis-server]
 123         if {![string match {*0 leaks*} $output]} {
 124             puts "--- Test \"$name\" leaked! ---"
 125             puts $output
 126             exit 1
 127         }
 128     }
 129 }