]> git.saurik.com Git - redis.git/blame - tests/test_helper.tcl
generated tests for different encodings to avoid test code duplication
[redis.git] / tests / test_helper.tcl
CommitLineData
98578b57
PN
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
5set tcl_precision 17
ab72b483 6source tests/support/redis.tcl
7source tests/support/server.tcl
8source tests/support/tmpfile.tcl
9source tests/support/test.tcl
10source tests/support/util.tcl
98578b57
PN
11
12set ::host 127.0.0.1
47bebf15 13set ::port 16379
98578b57 14set ::traceleaks 0
c4669d25 15set ::valgrind 0
6e0e5bed
PN
16set ::denytags {}
17set ::allowtags {}
98578b57
PN
18
19proc execute_tests name {
ab72b483 20 source "tests/$name.tcl"
98578b57
PN
21}
22
1c4114be
PN
23# Setup a list to hold a stack of server configs. When calls to start_server
24# are nested, use "srv 0 pid" to get the pid of the inner server. To access
25# outer servers, use "srv -1 pid" etcetera.
26set ::servers {}
27proc srv {level property} {
28 set srv [lindex $::servers end+$level]
29 dict get $srv $property
30}
31
32# Provide easy access to the client for the inner server. It's possible to
33# prepend the argument list with a negative level to access clients for
34# servers running in outer blocks.
98578b57 35proc r {args} {
1c4114be
PN
36 set level 0
37 if {[string is integer [lindex $args 0]]} {
38 set level [lindex $args 0]
39 set args [lrange $args 1 end]
40 }
41 [srv $level "client"] {*}$args
42}
43
44# Provide easy access to INFO properties. Same semantic as "proc r".
45proc s {args} {
46 set level 0
47 if {[string is integer [lindex $args 0]]} {
48 set level [lindex $args 0]
49 set args [lrange $args 1 end]
50 }
51 status [srv $level "client"] [lindex $args 0]
98578b57
PN
52}
53
f166bb1d 54proc cleanup {} {
c4669d25 55 catch {exec rm -rf {*}[glob tests/tmp/redis.conf.*]}
56 catch {exec rm -rf {*}[glob tests/tmp/server.*]}
f166bb1d
PN
57}
58
98578b57 59proc main {} {
f166bb1d 60 cleanup
98578b57
PN
61 execute_tests "unit/auth"
62 execute_tests "unit/protocol"
63 execute_tests "unit/basic"
64 execute_tests "unit/type/list"
65 execute_tests "unit/type/set"
66 execute_tests "unit/type/zset"
67 execute_tests "unit/type/hash"
68 execute_tests "unit/sort"
69 execute_tests "unit/expire"
70 execute_tests "unit/other"
c20c189d 71 execute_tests "unit/cas"
85ecc65e 72 execute_tests "integration/replication"
53cbf66c 73 execute_tests "integration/aof"
f166bb1d
PN
74
75 # run tests with VM enabled
d4507ec6 76 set ::global_overrides {vm-enabled yes}
f166bb1d
PN
77 execute_tests "unit/protocol"
78 execute_tests "unit/basic"
79 execute_tests "unit/type/list"
80 execute_tests "unit/type/set"
81 execute_tests "unit/type/zset"
82 execute_tests "unit/type/hash"
83 execute_tests "unit/sort"
84 execute_tests "unit/expire"
85 execute_tests "unit/other"
c20c189d 86 execute_tests "unit/cas"
98578b57
PN
87
88 puts "\n[expr $::passed+$::failed] tests, $::passed passed, $::failed failed"
89 if {$::failed > 0} {
90 puts "\n*** WARNING!!! $::failed FAILED TESTS ***\n"
91 }
f166bb1d
PN
92
93 cleanup
98578b57
PN
94}
95
73bd6c58
PN
96# parse arguments
97for {set j 0} {$j < [llength $argv]} {incr j} {
98 set opt [lindex $argv $j]
99 set arg [lindex $argv [expr $j+1]]
100 if {$opt eq {--tags}} {
101 foreach tag $arg {
102 if {[string index $tag 0] eq "-"} {
103 lappend ::denytags [string range $tag 1 end]
104 } else {
105 lappend ::allowtags $tag
106 }
107 }
108 incr j
109 } else {
110 puts "Wrong argument: $opt"
111 exit 1
112 }
113}
114
436f18b6
PN
115if {[catch { main } err]} {
116 if {[string length $err] > 0} {
117 # only display error when not generated by the test suite
118 if {$err ne "exception"} {
119 puts $err
120 }
121 exit 1
122 }
123}