tests/support/test.tcl

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