tests/support/test.tcl

   1 set ::passed 0
   2 set ::failed 0
   3 set ::testnum 0
   4
   5 proc assert_match {pattern value} {
   6     if {![string match $pattern $value]} {
   7         puts "!! ERROR\nExpected '$value' to match '$pattern'"
   8         error "assertion"
   9     }
  10 }
  11
  12 proc assert_equal {expected value} {
  13     if {$expected ne $value} {
  14         puts "!! ERROR\nExpected '$value' to be equal to '$expected'"
  15         error "assertion"
  16     }
  17 }
  18
  19 proc assert_error {pattern code} {
  20     if {[catch {uplevel 1 $code} error]} {
  21         assert_match $pattern $error
  22     } else {
  23         puts "!! ERROR\nExpected an error but nothing was catched"
  24         error "assertion"
  25     }
  26 }
  27
  28 proc assert_encoding {enc key} {
  29     # swapped out value doesn't have encoding, so swap in first
  30     r debug swapin $key
  31     assert_match "* encoding:$enc *" [r debug object $key]
  32 }
  33
  34 proc assert_type {type key} {
  35     assert_equal $type [r type $key]
  36 }
  37
  38 proc test {name code {okpattern notspecified}} {
  39     # abort if tagged with a tag to deny
  40     foreach tag $::denytags {
  41         if {[lsearch $::tags $tag] >= 0} {
  42             return
  43         }
  44     }
  45
  46     # check if tagged with at least 1 tag to allow when there *is* a list
  47     # of tags to allow, because default policy is to run everything
  48     if {[llength $::allowtags] > 0} {
  49         set matched 0
  50         foreach tag $::allowtags {
  51             if {[lsearch $::tags $tag] >= 0} {
  52                 incr matched
  53             }
  54         }
  55         if {$matched < 1} {
  56             return
  57         }
  58     }
  59
  60     incr ::testnum
  61     puts -nonewline [format "#%03d %-68s " $::testnum $name]
  62     flush stdout
  63     if {[catch {set retval [uplevel 1 $code]} error]} {
  64         if {$error eq "assertion"} {
  65             incr ::failed
  66         } else {
  67             puts "EXCEPTION"
  68             puts "\nCaught error: $error"
  69             error "exception"
  70         }
  71     } else {
  72         if {$okpattern eq "notspecified" || $okpattern eq $retval || [string match $okpattern $retval]} {
  73             puts "PASSED"
  74             incr ::passed
  75         } else {
  76             puts "!! ERROR expected\n'$okpattern'\nbut got\n'$retval'"
  77             incr ::failed
  78         }
  79     }
  80     if {$::traceleaks} {
  81         if {![string match {*0 leaks*} [exec leaks redis-server]]} {
  82             puts "--------- Test $::testnum LEAKED! --------"
  83             exit 1
  84         }
  85     }
  86 }