tests/test_helper.tcl

   1 # Redis test suite. Copyright (C) 2009 Salvatore Sanfilippo antirez@gmail.com
   2 # This softare is released under the BSD License. See the COPYING file for
   3 # more information.
   4
   5 set tcl_precision 17
   6 source tests/support/redis.tcl
   7 source tests/support/server.tcl
   8 source tests/support/tmpfile.tcl
   9 source tests/support/test.tcl
  10 source tests/support/util.tcl
  11
  12 set ::host 127.0.0.1
  13 set ::port 16379
  14 set ::traceleaks 0
  15
  16 proc execute_tests name {
  17     set cur $::testnum
  18     source "tests/$name.tcl"
  19 }
  20
  21 # Setup a list to hold a stack of server configs. When calls to start_server
  22 # are nested, use "srv 0 pid" to get the pid of the inner server. To access
  23 # outer servers, use "srv -1 pid" etcetera.
  24 set ::servers {}
  25 proc srv {level property} {
  26     set srv [lindex $::servers end+$level]
  27     dict get $srv $property
  28 }
  29
  30 # Provide easy access to the client for the inner server. It's possible to
  31 # prepend the argument list with a negative level to access clients for
  32 # servers running in outer blocks.
  33 proc r {args} {
  34     set level 0
  35     if {[string is integer [lindex $args 0]]} {
  36         set level [lindex $args 0]
  37         set args [lrange $args 1 end]
  38     }
  39     [srv $level "client"] {*}$args
  40 }
  41
  42 # Provide easy access to INFO properties. Same semantic as "proc r".
  43 proc s {args} {
  44     set level 0
  45     if {[string is integer [lindex $args 0]]} {
  46         set level [lindex $args 0]
  47         set args [lrange $args 1 end]
  48     }
  49     status [srv $level "client"] [lindex $args 0]
  50 }
  51
  52 proc main {} {
  53     execute_tests "unit/auth"
  54     execute_tests "unit/protocol"
  55     execute_tests "unit/basic"
  56     execute_tests "unit/type/list"
  57     execute_tests "unit/type/set"
  58     execute_tests "unit/type/zset"
  59     execute_tests "unit/type/hash"
  60     execute_tests "unit/sort"
  61     execute_tests "unit/expire"
  62     execute_tests "unit/other"
  63     execute_tests "integration/replication"
  64
  65     puts "\n[expr $::passed+$::failed] tests, $::passed passed, $::failed failed"
  66     if {$::failed > 0} {
  67         puts "\n*** WARNING!!! $::failed FAILED TESTS ***\n"
  68     }
  69
  70     # clean up tmp
  71     exec rm -rf {*}[glob tests/tmp/redis.conf.*]
  72     exec rm -rf {*}[glob tests/tmp/server.*]
  73 }
  74
  75 main