test_helper.tcl 3.3 KB
Newer Older
1 2 3 4 5
# Redis test suite. Copyright (C) 2009 Salvatore Sanfilippo antirez@gmail.com
# This softare is released under the BSD License. See the COPYING file for
# more information.

set tcl_precision 17
6 7 8 9 10
source tests/support/redis.tcl
source tests/support/server.tcl
source tests/support/tmpfile.tcl
source tests/support/test.tcl
source tests/support/util.tcl
11 12

set ::host 127.0.0.1
13
set ::port 16379
14
set ::traceleaks 0
15
set ::valgrind 0
P
Pieter Noordhuis 已提交
16 17
set ::denytags {}
set ::allowtags {}
18 19

proc execute_tests name {
20
    source "tests/$name.tcl"
21 22
}

23 24 25 26 27 28 29 30 31 32 33 34
# Setup a list to hold a stack of server configs. When calls to start_server
# are nested, use "srv 0 pid" to get the pid of the inner server. To access
# outer servers, use "srv -1 pid" etcetera.
set ::servers {}
proc srv {level property} {
    set srv [lindex $::servers end+$level]
    dict get $srv $property
}

# Provide easy access to the client for the inner server. It's possible to
# prepend the argument list with a negative level to access clients for
# servers running in outer blocks.
35
proc r {args} {
36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51
    set level 0
    if {[string is integer [lindex $args 0]]} {
        set level [lindex $args 0]
        set args [lrange $args 1 end]
    }
    [srv $level "client"] {*}$args
}

# Provide easy access to INFO properties. Same semantic as "proc r".
proc s {args} {
    set level 0
    if {[string is integer [lindex $args 0]]} {
        set level [lindex $args 0]
        set args [lrange $args 1 end]
    }
    status [srv $level "client"] [lindex $args 0]
52 53
}

54
proc cleanup {} {
55 56
    catch {exec rm -rf {*}[glob tests/tmp/redis.conf.*]}
    catch {exec rm -rf {*}[glob tests/tmp/server.*]}
57 58
}

59
proc main {} {
60
    cleanup
61 62 63 64 65 66 67 68 69 70
    execute_tests "unit/auth"
    execute_tests "unit/protocol"
    execute_tests "unit/basic"
    execute_tests "unit/type/list"
    execute_tests "unit/type/set"
    execute_tests "unit/type/zset"
    execute_tests "unit/type/hash"
    execute_tests "unit/sort"
    execute_tests "unit/expire"
    execute_tests "unit/other"
A
antirez 已提交
71
    execute_tests "unit/cas"
72
    execute_tests "integration/replication"
73
    execute_tests "integration/aof"
74 75

    # run tests with VM enabled
76
    set ::global_overrides {vm-enabled yes}
77 78 79 80 81 82 83 84 85
    execute_tests "unit/protocol"
    execute_tests "unit/basic"
    execute_tests "unit/type/list"
    execute_tests "unit/type/set"
    execute_tests "unit/type/zset"
    execute_tests "unit/type/hash"
    execute_tests "unit/sort"
    execute_tests "unit/expire"
    execute_tests "unit/other"
A
antirez 已提交
86
    execute_tests "unit/cas"
87 88 89 90 91
    
    puts "\n[expr $::passed+$::failed] tests, $::passed passed, $::failed failed"
    if {$::failed > 0} {
        puts "\n*** WARNING!!! $::failed FAILED TESTS ***\n"
    }
92 93

    cleanup
94 95
}

96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114
# parse arguments
for {set j 0} {$j < [llength $argv]} {incr j} {
    set opt [lindex $argv $j]
    set arg [lindex $argv [expr $j+1]]
    if {$opt eq {--tags}} {
        foreach tag $arg {
            if {[string index $tag 0] eq "-"} {
                lappend ::denytags [string range $tag 1 end]
            } else {
                lappend ::allowtags $tag
            }
        }
        incr j
    } else {
        puts "Wrong argument: $opt"
        exit 1
    }
}

115 116 117 118 119 120 121 122 123
if {[catch { main } err]} {
    if {[string length $err] > 0} {
        # only display error when not generated by the test suite
        if {$err ne "exception"} {
            puts $err
        }
        exit 1
    }
}