From 436f18b618d3820ee3c99b2ae78cf29bf36b2994 Mon Sep 17 00:00:00 2001
From: Pieter Noordhuis <pcnoordhuis@gmail.com>
Date: Wed, 2 Jun 2010 21:20:29 +0200
Subject: [PATCH 01/12] catch exceptions in the server proc, to be able to kill
 the entire chain of running servers

---
 tests/support/server.tcl | 32 ++++++++++++++++++++++++--------
 tests/support/test.tcl   | 12 +++---------
 tests/test_helper.tcl    | 10 +++++++++-
 3 files changed, 36 insertions(+), 18 deletions(-)

diff --git a/tests/support/server.tcl b/tests/support/server.tcl
index 9bec2bc7..750d799a 100644
--- a/tests/support/server.tcl
+++ b/tests/support/server.tcl
@@ -27,11 +27,13 @@ proc kill_server config {
     set pid [dict get $config pid]
 
     # check for leaks
-    catch {
-        if {[string match {*Darwin*} [exec uname -a]]} {
-            test "Check for memory leaks (pid $pid)" {
-                exec leaks $pid
-            } {*0 leaks*}
+    if {![dict exists $config "skipleaks"]} {
+        catch {
+            if {[string match {*Darwin*} [exec uname -a]]} {
+                test "Check for memory leaks (pid $pid)" {
+                    exec leaks $pid
+                } {*0 leaks*}
+            }
         }
     }
 
@@ -182,13 +184,27 @@ proc start_server {filename overrides {code undefined}} {
         # pop the server object
         set ::servers [lrange $::servers 0 end-1]
         
-        kill_server $srv
-
-        if {[string length $err] > 0} {
+        # allow an exception to bubble up the call chain but still kill this
+        # server, because we want to reuse the ports when the tests are re-run
+        if {$err eq "exception"} {
+            puts [format "Logged warnings (pid %d):" [dict get $srv "pid"]]
+            set warnings [warnings_from_file [dict get $srv "stdout"]]
+            if {[string length $warnings] > 0} {
+                puts "$warnings"
+            } else {
+                puts "(none)"
+            }
+            # kill this server without checking for leaks
+            dict set srv "skipleaks" 1
+            kill_server $srv
+            error "exception"
+        } elseif {[string length $err] > 0} {
             puts "Error executing the suite, aborting..."
             puts $err
             exit 1
         }
+
+        kill_server $srv
     } else {
         set _ $srv
     }
diff --git a/tests/support/test.tcl b/tests/support/test.tcl
index 6d5634ea..1fdeb1e9 100644
--- a/tests/support/test.tcl
+++ b/tests/support/test.tcl
@@ -8,15 +8,9 @@ proc test {name code okpattern} {
     puts -nonewline [format "#%03d %-68s " $::testnum $name]
     flush stdout
     if {[catch {set retval [uplevel 1 $code]} error]} {
-        puts "ERROR\n\nLogged warnings:"
-        foreach file [glob tests/tmp/server.[pid].*/stdout] {
-            set warnings [warnings_from_file $file]
-            if {[string length $warnings] > 0} {
-                puts $warnings
-            }
-        }
-        puts "Script died with $error"
-        exit 1
+        puts "EXCEPTION"
+        puts "\nCaught error: $error"
+        error "exception"
     }
     if {$okpattern eq $retval || [string match $okpattern $retval]} {
         puts "PASSED"
diff --git a/tests/test_helper.tcl b/tests/test_helper.tcl
index 035f013b..49239a3a 100644
--- a/tests/test_helper.tcl
+++ b/tests/test_helper.tcl
@@ -92,4 +92,12 @@ proc main {} {
     cleanup
 }
 
-main
+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
+    }
+}

From 38273a9ed6a92f5a9c0c6250484fff677b972019 Mon Sep 17 00:00:00 2001
From: Pieter Noordhuis <pcnoordhuis@gmail.com>
Date: Wed, 2 Jun 2010 21:29:47 +0200
Subject: [PATCH 02/12] removed obsolete code

---
 tests/support/test.tcl | 1 -
 tests/test_helper.tcl  | 1 -
 2 files changed, 2 deletions(-)

diff --git a/tests/support/test.tcl b/tests/support/test.tcl
index 1fdeb1e9..a7bcc801 100644
--- a/tests/support/test.tcl
+++ b/tests/support/test.tcl
@@ -4,7 +4,6 @@ set ::testnum 0
 
 proc test {name code okpattern} {
     incr ::testnum
-    # if {$::testnum < $::first || $::testnum > $::last} return
     puts -nonewline [format "#%03d %-68s " $::testnum $name]
     flush stdout
     if {[catch {set retval [uplevel 1 $code]} error]} {
diff --git a/tests/test_helper.tcl b/tests/test_helper.tcl
index 49239a3a..69d9bbf9 100644
--- a/tests/test_helper.tcl
+++ b/tests/test_helper.tcl
@@ -15,7 +15,6 @@ set ::traceleaks 0
 set ::valgrind 0
 
 proc execute_tests name {
-    set cur $::testnum
     source "tests/$name.tcl"
 }
 

From 9e5d2e8bd664743d309f1647e29cdaf43f463051 Mon Sep 17 00:00:00 2001
From: Pieter Noordhuis <pcnoordhuis@gmail.com>
Date: Wed, 2 Jun 2010 22:23:52 +0200
Subject: [PATCH 03/12] changed how server.tcl accepts options to support more
 directives without requiring more arguments to the proc

---
 tests/integration/aof.tcl         |  2 +-
 tests/integration/replication.tcl |  4 ++--
 tests/support/server.tcl          | 21 ++++++++++++++++-----
 tests/unit/auth.tcl               |  2 +-
 tests/unit/basic.tcl              |  2 +-
 tests/unit/cas.tcl                |  2 +-
 tests/unit/expire.tcl             |  2 +-
 tests/unit/other.tcl              |  2 +-
 tests/unit/protocol.tcl           |  2 +-
 tests/unit/sort.tcl               |  2 +-
 tests/unit/type/hash.tcl          |  2 +-
 tests/unit/type/list.tcl          |  2 +-
 tests/unit/type/set.tcl           |  2 +-
 tests/unit/type/zset.tcl          |  2 +-
 14 files changed, 30 insertions(+), 19 deletions(-)

diff --git a/tests/integration/aof.tcl b/tests/integration/aof.tcl
index 0d933449..ea2b399a 100644
--- a/tests/integration/aof.tcl
+++ b/tests/integration/aof.tcl
@@ -17,7 +17,7 @@ proc create_aof {code} {
 proc start_server_aof {overrides code} {
     upvar defaults defaults srv srv server_path server_path
     set _defaults $defaults
-    set srv [start_server default.conf [lappend _defaults $overrides]]
+    set srv [start_server {overrides [lappend _defaults $overrides]}]
     uplevel 1 $code
     kill_server $srv
 }
diff --git a/tests/integration/replication.tcl b/tests/integration/replication.tcl
index 6a97edf4..0f61b751 100644
--- a/tests/integration/replication.tcl
+++ b/tests/integration/replication.tcl
@@ -1,7 +1,7 @@
-start_server default.conf {} {
+start_server {} {
     r set mykey foo
     
-    start_server default.conf {} {
+    start_server {} {
         test {Second server should have role master at first} {
             s role
         } {master}
diff --git a/tests/support/server.tcl b/tests/support/server.tcl
index 750d799a..419267b4 100644
--- a/tests/support/server.tcl
+++ b/tests/support/server.tcl
@@ -81,8 +81,21 @@ proc ping_server {host port} {
 }
 
 set ::global_overrides {}
-proc start_server {filename overrides {code undefined}} {
-    set data [split [exec cat "tests/assets/$filename"] "\n"]
+proc start_server {options {code undefined}} {
+    # setup defaults
+    set baseconfig "default.conf"
+    set overrides {}
+
+    # parse options
+    foreach {option value} $options {
+        switch $option {
+            "config" { set baseconfig $value }
+            "overrides" { set overrides $value }
+            default { error "Unknown option $option" }
+        }
+    }
+
+    set data [split [exec cat "tests/assets/$baseconfig"] "\n"]
     set config {}
     foreach line $data {
         if {[string length $line] > 0 && [string index $line 0] ne "#"} {
@@ -100,9 +113,7 @@ proc start_server {filename overrides {code undefined}} {
     dict set config port [incr ::port]
 
     # apply overrides from global space and arguments
-    foreach override [concat $::global_overrides $overrides] {
-        set directive [lrange $override 0 0]
-        set arguments [lrange $override 1 end]
+    foreach {directive arguments} [concat $::global_overrides $overrides] {
         dict set config $directive $arguments
     }
     
diff --git a/tests/unit/auth.tcl b/tests/unit/auth.tcl
index 5bc83de8..a10358ce 100644
--- a/tests/unit/auth.tcl
+++ b/tests/unit/auth.tcl
@@ -1,4 +1,4 @@
-start_server default.conf {{requirepass foobar}} {
+start_server {overrides {requirepass foobar}} {
     test {AUTH fails when a wrong password is given} {
         catch {r auth wrong!} err
         format $err
diff --git a/tests/unit/basic.tcl b/tests/unit/basic.tcl
index b14ac6ed..edde91c4 100644
--- a/tests/unit/basic.tcl
+++ b/tests/unit/basic.tcl
@@ -1,4 +1,4 @@
-start_server default.conf {} {
+start_server {} {
     test {DEL all keys to start with a clean DB} {
         foreach key [r keys *] {r del $key}
         r dbsize
diff --git a/tests/unit/cas.tcl b/tests/unit/cas.tcl
index b8506796..febc7d6b 100644
--- a/tests/unit/cas.tcl
+++ b/tests/unit/cas.tcl
@@ -1,4 +1,4 @@
-start_server default.conf {} {
+start_server {} {
     test {EXEC works on WATCHed key not modified} {
         r watch x y z
         r watch k
diff --git a/tests/unit/expire.tcl b/tests/unit/expire.tcl
index 5954194c..c0dc8b94 100644
--- a/tests/unit/expire.tcl
+++ b/tests/unit/expire.tcl
@@ -1,4 +1,4 @@
-start_server default.conf {} {
+start_server {} {
     test {EXPIRE - don't set timeouts multiple times} {
         r set x foobar
         set v1 [r expire x 5]
diff --git a/tests/unit/other.tcl b/tests/unit/other.tcl
index 4d42c436..00d2dd46 100644
--- a/tests/unit/other.tcl
+++ b/tests/unit/other.tcl
@@ -1,4 +1,4 @@
-start_server default.conf {} {
+start_server {} {
     test {SAVE - make sure there are all the types as values} {
         # Wait for a background saving in progress to terminate
         waitForBgsave r
diff --git a/tests/unit/protocol.tcl b/tests/unit/protocol.tcl
index 28334e30..8717cd9f 100644
--- a/tests/unit/protocol.tcl
+++ b/tests/unit/protocol.tcl
@@ -1,4 +1,4 @@
-start_server default.conf {} {
+start_server {} {
     test {Handle an empty query well} {
         set fd [r channel]
         puts -nonewline $fd "\r\n"
diff --git a/tests/unit/sort.tcl b/tests/unit/sort.tcl
index 2985c3d9..6ae62cf7 100644
--- a/tests/unit/sort.tcl
+++ b/tests/unit/sort.tcl
@@ -1,4 +1,4 @@
-start_server default.conf {} {
+start_server {} {
     test {SORT ALPHA against integer encoded strings} {
         r del mylist
         r lpush mylist 2
diff --git a/tests/unit/type/hash.tcl b/tests/unit/type/hash.tcl
index 0d08cc55..fd44c0b8 100644
--- a/tests/unit/type/hash.tcl
+++ b/tests/unit/type/hash.tcl
@@ -1,4 +1,4 @@
-start_server default.conf {} {
+start_server {} {
     test {HSET/HLEN - Small hash creation} {
         array set smallhash {}
         for {set i 0} {$i < 8} {incr i} {
diff --git a/tests/unit/type/list.tcl b/tests/unit/type/list.tcl
index 2597f1b9..6b1a39a2 100644
--- a/tests/unit/type/list.tcl
+++ b/tests/unit/type/list.tcl
@@ -1,4 +1,4 @@
-start_server default.conf {} {
+start_server {} {
     test {Basic LPUSH, RPUSH, LLENGTH, LINDEX} {
         set res [r lpush mylist a]
         append res [r lpush mylist b]
diff --git a/tests/unit/type/set.tcl b/tests/unit/type/set.tcl
index c8d1a695..c69f8ece 100644
--- a/tests/unit/type/set.tcl
+++ b/tests/unit/type/set.tcl
@@ -1,4 +1,4 @@
-start_server default.conf {} {
+start_server {} {
     test {SADD, SCARD, SISMEMBER, SMEMBERS basics} {
         r sadd myset foo
         r sadd myset bar
diff --git a/tests/unit/type/zset.tcl b/tests/unit/type/zset.tcl
index 9eb61f25..0bdefeae 100644
--- a/tests/unit/type/zset.tcl
+++ b/tests/unit/type/zset.tcl
@@ -1,4 +1,4 @@
-start_server default.conf {} {
+start_server {} {
     test {ZSET basic ZADD and score update} {
         r zadd ztmp 10 x
         r zadd ztmp 20 y

From 6e0e5bedd9c3a4bf0f53f43c427c88e2866bda0a Mon Sep 17 00:00:00 2001
From: Pieter Noordhuis <pcnoordhuis@gmail.com>
Date: Wed, 2 Jun 2010 22:53:22 +0200
Subject: [PATCH 04/12] basic support to tag tests

---
 tests/support/server.tcl | 32 ++++++++++++++++++++++++++++----
 tests/support/test.tcl   | 21 +++++++++++++++++++++
 tests/test_helper.tcl    |  2 ++
 tests/unit/basic.tcl     |  4 +++-
 4 files changed, 54 insertions(+), 5 deletions(-)

diff --git a/tests/support/server.tcl b/tests/support/server.tcl
index 419267b4..551e24d1 100644
--- a/tests/support/server.tcl
+++ b/tests/support/server.tcl
@@ -1,3 +1,6 @@
+set ::global_overrides {}
+set ::tags {}
+
 proc error_and_quit {config_file error} {
     puts "!!COULD NOT START REDIS-SERVER\n"
     puts "CONFIGURATION:"
@@ -80,18 +83,31 @@ proc ping_server {host port} {
     return $retval
 }
 
-set ::global_overrides {}
+# doesn't really belong here, but highly coupled to code in start_server
+proc tags {tags code} {
+    set ::tags [concat $::tags $tags]
+    uplevel 1 $code
+    set ::tags [lrange $::tags 0 end-[llength $tags]]
+}
+
 proc start_server {options {code undefined}} {
     # setup defaults
     set baseconfig "default.conf"
     set overrides {}
+    set tags {}
 
     # parse options
     foreach {option value} $options {
         switch $option {
-            "config" { set baseconfig $value }
-            "overrides" { set overrides $value }
-            default { error "Unknown option $option" }
+            "config" {
+                set baseconfig $value }
+            "overrides" {
+                set overrides $value }
+            "tags" {
+                set tags $value
+                set ::tags [concat $::tags $value] }
+            default {
+                error "Unknown option $option" }
         }
     }
 
@@ -190,7 +206,12 @@ proc start_server {options {code undefined}} {
         lappend ::servers $srv
         
         # execute provided block
+        set curnum $::testnum
         catch { uplevel 1 $code } err
+        if {$curnum == $::testnum} {
+            # don't check for leaks when no tests were executed
+            dict set srv "skipleaks" 1
+        }
 
         # pop the server object
         set ::servers [lrange $::servers 0 end-1]
@@ -219,4 +240,7 @@ proc start_server {options {code undefined}} {
     } else {
         set _ $srv
     }
+
+    # remove tags
+    set ::tags [lrange $::tags 0 end-[llength $tags]]
 }
diff --git a/tests/support/test.tcl b/tests/support/test.tcl
index a7bcc801..c13072f0 100644
--- a/tests/support/test.tcl
+++ b/tests/support/test.tcl
@@ -3,6 +3,27 @@ set ::failed 0
 set ::testnum 0
 
 proc test {name code okpattern} {
+    # abort if tagged with a tag to deny
+    foreach tag $::denytags {
+        if {[lsearch $::tags $tag] >= 0} {
+            return
+        }
+    }
+
+    # check if tagged with at least 1 tag to allow when there *is* a list
+    # of tags to allow, because default policy is to run everything
+    if {[llength $::allowtags] > 0} {
+        set matched 0
+        foreach tag $::allowtags {
+            if {[lsearch $::tags $tag]} {
+                incr matched
+            }
+        }
+        if {$matched < 1} {
+            return
+        }
+    }
+
     incr ::testnum
     puts -nonewline [format "#%03d %-68s " $::testnum $name]
     flush stdout
diff --git a/tests/test_helper.tcl b/tests/test_helper.tcl
index 69d9bbf9..da9071e8 100644
--- a/tests/test_helper.tcl
+++ b/tests/test_helper.tcl
@@ -13,6 +13,8 @@ set ::host 127.0.0.1
 set ::port 16379
 set ::traceleaks 0
 set ::valgrind 0
+set ::denytags {}
+set ::allowtags {}
 
 proc execute_tests name {
     source "tests/$name.tcl"
diff --git a/tests/unit/basic.tcl b/tests/unit/basic.tcl
index edde91c4..a271432c 100644
--- a/tests/unit/basic.tcl
+++ b/tests/unit/basic.tcl
@@ -1,4 +1,4 @@
-start_server {} {
+start_server {tags {basic}} {
     test {DEL all keys to start with a clean DB} {
         foreach key [r keys *] {r del $key}
         r dbsize
@@ -52,6 +52,7 @@ start_server {} {
         r get foo
     } [string repeat "abcd" 1000000]
 
+    tags {slow} {
     test {Very big payload random access} {
         set err {}
         array set payload {}
@@ -92,6 +93,7 @@ start_server {} {
     test {DBSIZE should be 10101 now} {
         r dbsize
     } {10101}
+    }
 
     test {INCR against non existing key} {
         set res {}

From 73bd6c583b9a3e29dbbbf4f1ba8259cfe5e131b8 Mon Sep 17 00:00:00 2001
From: Pieter Noordhuis <pcnoordhuis@gmail.com>
Date: Wed, 2 Jun 2010 23:04:22 +0200
Subject: [PATCH 05/12] pass tags to filter and match via arguments

---
 Makefile               |  2 +-
 tests/support/test.tcl |  2 +-
 tests/test_helper.tcl  | 19 +++++++++++++++++++
 3 files changed, 21 insertions(+), 2 deletions(-)

diff --git a/Makefile b/Makefile
index b7dfb1cd..31a763ad 100644
--- a/Makefile
+++ b/Makefile
@@ -86,7 +86,7 @@ staticsymbols:
 	tclsh utils/build-static-symbols.tcl > staticsymbols.h
 
 test:
-	tclsh8.5 tests/test_helper.tcl
+	tclsh8.5 tests/test_helper.tcl --tags "${TAGS}"
 
 bench:
 	./redis-benchmark
diff --git a/tests/support/test.tcl b/tests/support/test.tcl
index c13072f0..d2674da1 100644
--- a/tests/support/test.tcl
+++ b/tests/support/test.tcl
@@ -15,7 +15,7 @@ proc test {name code okpattern} {
     if {[llength $::allowtags] > 0} {
         set matched 0
         foreach tag $::allowtags {
-            if {[lsearch $::tags $tag]} {
+            if {[lsearch $::tags $tag] >= 0} {
                 incr matched
             }
         }
diff --git a/tests/test_helper.tcl b/tests/test_helper.tcl
index da9071e8..95508cda 100644
--- a/tests/test_helper.tcl
+++ b/tests/test_helper.tcl
@@ -93,6 +93,25 @@ proc main {} {
     cleanup
 }
 
+# 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
+    }
+}
+
 if {[catch { main } err]} {
     if {[string length $err] > 0} {
         # only display error when not generated by the test suite

From 7f7499eeace8f69aeb32a4e92554eb0b144e8226 Mon Sep 17 00:00:00 2001
From: Pieter Noordhuis <pcnoordhuis@gmail.com>
Date: Wed, 2 Jun 2010 23:14:55 +0200
Subject: [PATCH 06/12] tags for existing tests

---
 tests/integration/aof.tcl         | 112 ++++++++-------
 tests/integration/replication.tcl |   2 +-
 tests/unit/auth.tcl               |   2 +-
 tests/unit/basic.tcl              |  78 +++++-----
 tests/unit/cas.tcl                |   2 +-
 tests/unit/expire.tcl             |   2 +-
 tests/unit/sort.tcl               | 224 +++++++++++++++--------------
 tests/unit/type/hash.tcl          |   2 +-
 tests/unit/type/list.tcl          |   2 +-
 tests/unit/type/set.tcl           |   2 +-
 tests/unit/type/zset.tcl          | 230 +++++++++++++++---------------
 11 files changed, 333 insertions(+), 325 deletions(-)

diff --git a/tests/integration/aof.tcl b/tests/integration/aof.tcl
index ea2b399a..aca8a0f4 100644
--- a/tests/integration/aof.tcl
+++ b/tests/integration/aof.tcl
@@ -22,59 +22,61 @@ proc start_server_aof {overrides code} {
     kill_server $srv
 }
 
-## Test the server doesn't start when the AOF contains an unfinished MULTI
-create_aof {
-    append_to_aof [formatCommand set foo hello]
-    append_to_aof [formatCommand multi]
-    append_to_aof [formatCommand set bar world]
-}
-
-start_server_aof [list dir $server_path] {
-    test {Unfinished MULTI: Server should not have been started} {
-        is_alive $srv
-    } {0}
-
-    test {Unfinished MULTI: Server should have logged an error} {
-        exec cat [dict get $srv stdout] | tail -n1
-    } {*Unexpected end of file reading the append only file*}
-}
-
-## Test that the server exits when the AOF contains a short read
-create_aof {
-    append_to_aof [formatCommand set foo hello]
-    append_to_aof [string range [formatCommand set bar world] 0 end-1]
-}
-
-start_server_aof [list dir $server_path] {
-    test {Short read: Server should not have been started} {
-        is_alive $srv
-    } {0}
-
-    test {Short read: Server should have logged an error} {
-        exec cat [dict get $srv stdout] | tail -n1
-    } {*Bad file format reading the append only file*}
-}
-
-## Test that redis-check-aof indeed sees this AOF is not valid
-test {Short read: Utility should confirm the AOF is not valid} {
-    catch {
-        exec ./redis-check-aof $aof_path
-    } str
-    set _ $str
-} {*not valid*}
-
-test {Short read: Utility should be able to fix the AOF} {
-    exec echo y | ./redis-check-aof --fix $aof_path
-} {*Successfully truncated AOF*}
-
-## Test that the server can be started using the truncated AOF
-start_server_aof [list dir $server_path] {
-    test {Fixed AOF: Server should have been started} {
-        is_alive $srv
-    } {1}
-
-    test {Fixed AOF: Keyspace should contain values that were parsable} {
-        set client [redis [dict get $srv host] [dict get $srv port]]
-        list [$client get foo] [$client get bar]
-    } {hello {}}
+tags {"aof"} {
+    ## Test the server doesn't start when the AOF contains an unfinished MULTI
+    create_aof {
+        append_to_aof [formatCommand set foo hello]
+        append_to_aof [formatCommand multi]
+        append_to_aof [formatCommand set bar world]
+    }
+
+    start_server_aof [list dir $server_path] {
+        test {Unfinished MULTI: Server should not have been started} {
+            is_alive $srv
+        } {0}
+
+        test {Unfinished MULTI: Server should have logged an error} {
+            exec cat [dict get $srv stdout] | tail -n1
+        } {*Unexpected end of file reading the append only file*}
+    }
+
+    ## Test that the server exits when the AOF contains a short read
+    create_aof {
+        append_to_aof [formatCommand set foo hello]
+        append_to_aof [string range [formatCommand set bar world] 0 end-1]
+    }
+
+    start_server_aof [list dir $server_path] {
+        test {Short read: Server should not have been started} {
+            is_alive $srv
+        } {0}
+
+        test {Short read: Server should have logged an error} {
+            exec cat [dict get $srv stdout] | tail -n1
+        } {*Bad file format reading the append only file*}
+    }
+
+    ## Test that redis-check-aof indeed sees this AOF is not valid
+    test {Short read: Utility should confirm the AOF is not valid} {
+        catch {
+            exec ./redis-check-aof $aof_path
+        } str
+        set _ $str
+    } {*not valid*}
+
+    test {Short read: Utility should be able to fix the AOF} {
+        exec echo y | ./redis-check-aof --fix $aof_path
+    } {*Successfully truncated AOF*}
+
+    ## Test that the server can be started using the truncated AOF
+    start_server_aof [list dir $server_path] {
+        test {Fixed AOF: Server should have been started} {
+            is_alive $srv
+        } {1}
+
+        test {Fixed AOF: Keyspace should contain values that were parsable} {
+            set client [redis [dict get $srv host] [dict get $srv port]]
+            list [$client get foo] [$client get bar]
+        } {hello {}}
+    }
 }
diff --git a/tests/integration/replication.tcl b/tests/integration/replication.tcl
index 0f61b751..0f5d496d 100644
--- a/tests/integration/replication.tcl
+++ b/tests/integration/replication.tcl
@@ -1,4 +1,4 @@
-start_server {} {
+start_server {tags {"repl"}} {
     r set mykey foo
     
     start_server {} {
diff --git a/tests/unit/auth.tcl b/tests/unit/auth.tcl
index a10358ce..8ccda95d 100644
--- a/tests/unit/auth.tcl
+++ b/tests/unit/auth.tcl
@@ -1,4 +1,4 @@
-start_server {overrides {requirepass foobar}} {
+start_server {tags {"auth"} overrides {requirepass foobar}} {
     test {AUTH fails when a wrong password is given} {
         catch {r auth wrong!} err
         format $err
diff --git a/tests/unit/basic.tcl b/tests/unit/basic.tcl
index a271432c..0d50fa1b 100644
--- a/tests/unit/basic.tcl
+++ b/tests/unit/basic.tcl
@@ -1,4 +1,4 @@
-start_server {tags {basic}} {
+start_server {tags {"basic"}} {
     test {DEL all keys to start with a clean DB} {
         foreach key [r keys *] {r del $key}
         r dbsize
@@ -52,47 +52,47 @@ start_server {tags {basic}} {
         r get foo
     } [string repeat "abcd" 1000000]
 
-    tags {slow} {
-    test {Very big payload random access} {
-        set err {}
-        array set payload {}
-        for {set j 0} {$j < 100} {incr j} {
-            set size [expr 1+[randomInt 100000]]
-            set buf [string repeat "pl-$j" $size]
-            set payload($j) $buf
-            r set bigpayload_$j $buf
-        }
-        for {set j 0} {$j < 1000} {incr j} {
-            set index [randomInt 100]
-            set buf [r get bigpayload_$index]
-            if {$buf != $payload($index)} {
-                set err "Values differ: I set '$payload($index)' but I read back '$buf'"
-                break
+    tags {"slow"} {
+        test {Very big payload random access} {
+            set err {}
+            array set payload {}
+            for {set j 0} {$j < 100} {incr j} {
+                set size [expr 1+[randomInt 100000]]
+                set buf [string repeat "pl-$j" $size]
+                set payload($j) $buf
+                r set bigpayload_$j $buf
             }
-        }
-        unset payload
-        set _ $err
-    } {}
-
-    test {SET 10000 numeric keys and access all them in reverse order} {
-        set err {}
-        for {set x 0} {$x < 10000} {incr x} {
-            r set $x $x
-        }
-        set sum 0
-        for {set x 9999} {$x >= 0} {incr x -1} {
-            set val [r get $x]
-            if {$val ne $x} {
-                set err "Eleemnt at position $x is $val instead of $x"
-                break
+            for {set j 0} {$j < 1000} {incr j} {
+                set index [randomInt 100]
+                set buf [r get bigpayload_$index]
+                if {$buf != $payload($index)} {
+                    set err "Values differ: I set '$payload($index)' but I read back '$buf'"
+                    break
+                }
             }
-        }
-        set _ $err
-    } {}
+            unset payload
+            set _ $err
+        } {}
 
-    test {DBSIZE should be 10101 now} {
-        r dbsize
-    } {10101}
+        test {SET 10000 numeric keys and access all them in reverse order} {
+            set err {}
+            for {set x 0} {$x < 10000} {incr x} {
+                r set $x $x
+            }
+            set sum 0
+            for {set x 9999} {$x >= 0} {incr x -1} {
+                set val [r get $x]
+                if {$val ne $x} {
+                    set err "Eleemnt at position $x is $val instead of $x"
+                    break
+                }
+            }
+            set _ $err
+        } {}
+
+        test {DBSIZE should be 10101 now} {
+            r dbsize
+        } {10101}
     }
 
     test {INCR against non existing key} {
diff --git a/tests/unit/cas.tcl b/tests/unit/cas.tcl
index febc7d6b..dc6a5ef7 100644
--- a/tests/unit/cas.tcl
+++ b/tests/unit/cas.tcl
@@ -1,4 +1,4 @@
-start_server {} {
+start_server {tags {"cas"}} {
     test {EXEC works on WATCHed key not modified} {
         r watch x y z
         r watch k
diff --git a/tests/unit/expire.tcl b/tests/unit/expire.tcl
index c0dc8b94..6b2fe747 100644
--- a/tests/unit/expire.tcl
+++ b/tests/unit/expire.tcl
@@ -1,4 +1,4 @@
-start_server {} {
+start_server {tags {"expire"}} {
     test {EXPIRE - don't set timeouts multiple times} {
         r set x foobar
         set v1 [r expire x 5]
diff --git a/tests/unit/sort.tcl b/tests/unit/sort.tcl
index 6ae62cf7..6ae2180d 100644
--- a/tests/unit/sort.tcl
+++ b/tests/unit/sort.tcl
@@ -1,4 +1,4 @@
-start_server {} {
+start_server {tags {"sort"}} {
     test {SORT ALPHA against integer encoded strings} {
         r del mylist
         r lpush mylist 2
@@ -8,130 +8,132 @@ start_server {} {
         r sort mylist alpha
     } {1 10 2 3}
 
-    test {Create a random list and a random set} {
-        set tosort {}
-        array set seenrand {}
-        for {set i 0} {$i < 10000} {incr i} {
-            while 1 {
-                # Make sure all the weights are different because
-                # Redis does not use a stable sort but Tcl does.
-                randpath {
-                    set rint [expr int(rand()*1000000)]
-                } {
-                    set rint [expr rand()]
+    tags {"slow"} {
+        test {Create a random list and a random set} {
+            set tosort {}
+            array set seenrand {}
+            for {set i 0} {$i < 10000} {incr i} {
+                while 1 {
+                    # Make sure all the weights are different because
+                    # Redis does not use a stable sort but Tcl does.
+                    randpath {
+                        set rint [expr int(rand()*1000000)]
+                    } {
+                        set rint [expr rand()]
+                    }
+                    if {![info exists seenrand($rint)]} break
                 }
-                if {![info exists seenrand($rint)]} break
+                set seenrand($rint) x
+                r lpush tosort $i
+                r sadd tosort-set $i
+                r set weight_$i $rint
+                r hset wobj_$i weight $rint
+                lappend tosort [list $i $rint]
             }
-            set seenrand($rint) x
-            r lpush tosort $i
-            r sadd tosort-set $i
-            r set weight_$i $rint
-            r hset wobj_$i weight $rint
-            lappend tosort [list $i $rint]
-        }
-        set sorted [lsort -index 1 -real $tosort]
-        set res {}
-        for {set i 0} {$i < 10000} {incr i} {
-            lappend res [lindex $sorted $i 0]
-        }
-        format {}
-    } {}
-
-    test {SORT with BY against the newly created list} {
-        r sort tosort {BY weight_*}
-    } $res
-
-    test {SORT with BY (hash field) against the newly created list} {
-        r sort tosort {BY wobj_*->weight}
-    } $res
-
-    test {SORT with GET (key+hash) with sanity check of each element (list)} {
-        set err {}
-        set l1 [r sort tosort GET # GET weight_*]
-        set l2 [r sort tosort GET # GET wobj_*->weight]
-        foreach {id1 w1} $l1 {id2 w2} $l2 {
-            set realweight [r get weight_$id1]
-            if {$id1 != $id2} {
-                set err "ID mismatch $id1 != $id2"
-                break
+            set sorted [lsort -index 1 -real $tosort]
+            set res {}
+            for {set i 0} {$i < 10000} {incr i} {
+                lappend res [lindex $sorted $i 0]
             }
-            if {$realweight != $w1 || $realweight != $w2} {
-                set err "Weights mismatch! w1: $w1 w2: $w2 real: $realweight"
-                break
+            format {}
+        } {}
+
+        test {SORT with BY against the newly created list} {
+            r sort tosort {BY weight_*}
+        } $res
+
+        test {SORT with BY (hash field) against the newly created list} {
+            r sort tosort {BY wobj_*->weight}
+        } $res
+
+        test {SORT with GET (key+hash) with sanity check of each element (list)} {
+            set err {}
+            set l1 [r sort tosort GET # GET weight_*]
+            set l2 [r sort tosort GET # GET wobj_*->weight]
+            foreach {id1 w1} $l1 {id2 w2} $l2 {
+                set realweight [r get weight_$id1]
+                if {$id1 != $id2} {
+                    set err "ID mismatch $id1 != $id2"
+                    break
+                }
+                if {$realweight != $w1 || $realweight != $w2} {
+                    set err "Weights mismatch! w1: $w1 w2: $w2 real: $realweight"
+                    break
+                }
             }
-        }
-        set _ $err
-    } {}
+            set _ $err
+        } {}
 
-    test {SORT with BY, but against the newly created set} {
-        r sort tosort-set {BY weight_*}
-    } $res
+        test {SORT with BY, but against the newly created set} {
+            r sort tosort-set {BY weight_*}
+        } $res
 
-    test {SORT with BY (hash field), but against the newly created set} {
-        r sort tosort-set {BY wobj_*->weight}
-    } $res
+        test {SORT with BY (hash field), but against the newly created set} {
+            r sort tosort-set {BY wobj_*->weight}
+        } $res
 
-    test {SORT with BY and STORE against the newly created list} {
-        r sort tosort {BY weight_*} store sort-res
-        r lrange sort-res 0 -1
-    } $res
+        test {SORT with BY and STORE against the newly created list} {
+            r sort tosort {BY weight_*} store sort-res
+            r lrange sort-res 0 -1
+        } $res
 
-    test {SORT with BY (hash field) and STORE against the newly created list} {
-        r sort tosort {BY wobj_*->weight} store sort-res
-        r lrange sort-res 0 -1
-    } $res
+        test {SORT with BY (hash field) and STORE against the newly created list} {
+            r sort tosort {BY wobj_*->weight} store sort-res
+            r lrange sort-res 0 -1
+        } $res
 
-    test {SORT direct, numeric, against the newly created list} {
-        r sort tosort
-    } [lsort -integer $res]
+        test {SORT direct, numeric, against the newly created list} {
+            r sort tosort
+        } [lsort -integer $res]
 
-    test {SORT decreasing sort} {
-        r sort tosort {DESC}
-    } [lsort -decreasing -integer $res]
+        test {SORT decreasing sort} {
+            r sort tosort {DESC}
+        } [lsort -decreasing -integer $res]
 
-    test {SORT speed, sorting 10000 elements list using BY, 100 times} {
-        set start [clock clicks -milliseconds]
-        for {set i 0} {$i < 100} {incr i} {
-            set sorted [r sort tosort {BY weight_* LIMIT 0 10}]
-        }
-        set elapsed [expr [clock clicks -milliseconds]-$start]
-        puts -nonewline "\n  Average time to sort: [expr double($elapsed)/100] milliseconds "
-        flush stdout
-        format {}
-    } {}
+        test {SORT speed, sorting 10000 elements list using BY, 100 times} {
+            set start [clock clicks -milliseconds]
+            for {set i 0} {$i < 100} {incr i} {
+                set sorted [r sort tosort {BY weight_* LIMIT 0 10}]
+            }
+            set elapsed [expr [clock clicks -milliseconds]-$start]
+            puts -nonewline "\n  Average time to sort: [expr double($elapsed)/100] milliseconds "
+            flush stdout
+            format {}
+        } {}
 
-    test {SORT speed, as above but against hash field} {
-        set start [clock clicks -milliseconds]
-        for {set i 0} {$i < 100} {incr i} {
-            set sorted [r sort tosort {BY wobj_*->weight LIMIT 0 10}]
-        }
-        set elapsed [expr [clock clicks -milliseconds]-$start]
-        puts -nonewline "\n  Average time to sort: [expr double($elapsed)/100] milliseconds "
-        flush stdout
-        format {}
-    } {}
+        test {SORT speed, as above but against hash field} {
+            set start [clock clicks -milliseconds]
+            for {set i 0} {$i < 100} {incr i} {
+                set sorted [r sort tosort {BY wobj_*->weight LIMIT 0 10}]
+            }
+            set elapsed [expr [clock clicks -milliseconds]-$start]
+            puts -nonewline "\n  Average time to sort: [expr double($elapsed)/100] milliseconds "
+            flush stdout
+            format {}
+        } {}
 
-    test {SORT speed, sorting 10000 elements list directly, 100 times} {
-        set start [clock clicks -milliseconds]
-        for {set i 0} {$i < 100} {incr i} {
-            set sorted [r sort tosort {LIMIT 0 10}]
-        }
-        set elapsed [expr [clock clicks -milliseconds]-$start]
-        puts -nonewline "\n  Average time to sort: [expr double($elapsed)/100] milliseconds "
-        flush stdout
-        format {}
-    } {}
+        test {SORT speed, sorting 10000 elements list directly, 100 times} {
+            set start [clock clicks -milliseconds]
+            for {set i 0} {$i < 100} {incr i} {
+                set sorted [r sort tosort {LIMIT 0 10}]
+            }
+            set elapsed [expr [clock clicks -milliseconds]-$start]
+            puts -nonewline "\n  Average time to sort: [expr double($elapsed)/100] milliseconds "
+            flush stdout
+            format {}
+        } {}
 
-    test {SORT speed, pseudo-sorting 10000 elements list, BY <const>, 100 times} {
-        set start [clock clicks -milliseconds]
-        for {set i 0} {$i < 100} {incr i} {
-            set sorted [r sort tosort {BY nokey LIMIT 0 10}]
-        }
-        set elapsed [expr [clock clicks -milliseconds]-$start]
-        puts -nonewline "\n  Average time to sort: [expr double($elapsed)/100] milliseconds "
-        flush stdout
-        format {}
-    } {}
+        test {SORT speed, pseudo-sorting 10000 elements list, BY <const>, 100 times} {
+            set start [clock clicks -milliseconds]
+            for {set i 0} {$i < 100} {incr i} {
+                set sorted [r sort tosort {BY nokey LIMIT 0 10}]
+            }
+            set elapsed [expr [clock clicks -milliseconds]-$start]
+            puts -nonewline "\n  Average time to sort: [expr double($elapsed)/100] milliseconds "
+            flush stdout
+            format {}
+        } {}
+    }
 
     test {SORT regression for issue #19, sorting floats} {
         r flushdb
diff --git a/tests/unit/type/hash.tcl b/tests/unit/type/hash.tcl
index fd44c0b8..ef49a27d 100644
--- a/tests/unit/type/hash.tcl
+++ b/tests/unit/type/hash.tcl
@@ -1,4 +1,4 @@
-start_server {} {
+start_server {tags {"hash"}} {
     test {HSET/HLEN - Small hash creation} {
         array set smallhash {}
         for {set i 0} {$i < 8} {incr i} {
diff --git a/tests/unit/type/list.tcl b/tests/unit/type/list.tcl
index 6b1a39a2..2a5d13bd 100644
--- a/tests/unit/type/list.tcl
+++ b/tests/unit/type/list.tcl
@@ -1,4 +1,4 @@
-start_server {} {
+start_server {tags {"list"}} {
     test {Basic LPUSH, RPUSH, LLENGTH, LINDEX} {
         set res [r lpush mylist a]
         append res [r lpush mylist b]
diff --git a/tests/unit/type/set.tcl b/tests/unit/type/set.tcl
index c69f8ece..58ea2b5b 100644
--- a/tests/unit/type/set.tcl
+++ b/tests/unit/type/set.tcl
@@ -1,4 +1,4 @@
-start_server {} {
+start_server {tags {"set"}} {
     test {SADD, SCARD, SISMEMBER, SMEMBERS basics} {
         r sadd myset foo
         r sadd myset bar
diff --git a/tests/unit/type/zset.tcl b/tests/unit/type/zset.tcl
index 0bdefeae..60459783 100644
--- a/tests/unit/type/zset.tcl
+++ b/tests/unit/type/zset.tcl
@@ -1,4 +1,4 @@
-start_server {} {
+start_server {tags {"zset"}} {
     test {ZSET basic ZADD and score update} {
         r zadd ztmp 10 x
         r zadd ztmp 20 y
@@ -162,85 +162,87 @@ start_server {} {
         r zrangebyscore zset 2 4 withscores
     } {b 2 c 3 d 4}
 
-    test {ZRANGEBYSCORE fuzzy test, 100 ranges in 1000 elements sorted set} {
-        set err {}
-        r del zset
-        for {set i 0} {$i < 1000} {incr i} {
-            r zadd zset [expr rand()] $i
-        }
-        for {set i 0} {$i < 100} {incr i} {
-            set min [expr rand()]
-            set max [expr rand()]
-            if {$min > $max} {
-                set aux $min
-                set min $max
-                set max $aux
+    tags {"slow"} {
+        test {ZRANGEBYSCORE fuzzy test, 100 ranges in 1000 elements sorted set} {
+            set err {}
+            r del zset
+            for {set i 0} {$i < 1000} {incr i} {
+                r zadd zset [expr rand()] $i
             }
-            set low [r zrangebyscore zset -inf $min]
-            set ok [r zrangebyscore zset $min $max]
-            set high [r zrangebyscore zset $max +inf]
-            set lowx [r zrangebyscore zset -inf ($min]
-            set okx [r zrangebyscore zset ($min ($max]
-            set highx [r zrangebyscore zset ($max +inf]
+            for {set i 0} {$i < 100} {incr i} {
+                set min [expr rand()]
+                set max [expr rand()]
+                if {$min > $max} {
+                    set aux $min
+                    set min $max
+                    set max $aux
+                }
+                set low [r zrangebyscore zset -inf $min]
+                set ok [r zrangebyscore zset $min $max]
+                set high [r zrangebyscore zset $max +inf]
+                set lowx [r zrangebyscore zset -inf ($min]
+                set okx [r zrangebyscore zset ($min ($max]
+                set highx [r zrangebyscore zset ($max +inf]
 
-            if {[r zcount zset -inf $min] != [llength $low]} {
-                append err "Error, len does not match zcount\n"
-            }
-            if {[r zcount zset $min $max] != [llength $ok]} {
-                append err "Error, len does not match zcount\n"
-            }
-            if {[r zcount zset $max +inf] != [llength $high]} {
-                append err "Error, len does not match zcount\n"
-            }
-            if {[r zcount zset -inf ($min] != [llength $lowx]} {
-                append err "Error, len does not match zcount\n"
-            }
-            if {[r zcount zset ($min ($max] != [llength $okx]} {
-                append err "Error, len does not match zcount\n"
-            }
-            if {[r zcount zset ($max +inf] != [llength $highx]} {
-                append err "Error, len does not match zcount\n"
-            }
+                if {[r zcount zset -inf $min] != [llength $low]} {
+                    append err "Error, len does not match zcount\n"
+                }
+                if {[r zcount zset $min $max] != [llength $ok]} {
+                    append err "Error, len does not match zcount\n"
+                }
+                if {[r zcount zset $max +inf] != [llength $high]} {
+                    append err "Error, len does not match zcount\n"
+                }
+                if {[r zcount zset -inf ($min] != [llength $lowx]} {
+                    append err "Error, len does not match zcount\n"
+                }
+                if {[r zcount zset ($min ($max] != [llength $okx]} {
+                    append err "Error, len does not match zcount\n"
+                }
+                if {[r zcount zset ($max +inf] != [llength $highx]} {
+                    append err "Error, len does not match zcount\n"
+                }
 
-            foreach x $low {
-                set score [r zscore zset $x]
-                if {$score > $min} {
-                    append err "Error, score for $x is $score > $min\n"
+                foreach x $low {
+                    set score [r zscore zset $x]
+                    if {$score > $min} {
+                        append err "Error, score for $x is $score > $min\n"
+                    }
+                }
+                foreach x $lowx {
+                    set score [r zscore zset $x]
+                    if {$score >= $min} {
+                        append err "Error, score for $x is $score >= $min\n"
+                    }
+                }
+                foreach x $ok {
+                    set score [r zscore zset $x]
+                    if {$score < $min || $score > $max} {
+                        append err "Error, score for $x is $score outside $min-$max range\n"
+                    }
+                }
+                foreach x $okx {
+                    set score [r zscore zset $x]
+                    if {$score <= $min || $score >= $max} {
+                        append err "Error, score for $x is $score outside $min-$max open range\n"
+                    }
+                }
+                foreach x $high {
+                    set score [r zscore zset $x]
+                    if {$score < $max} {
+                        append err "Error, score for $x is $score < $max\n"
+                    }
+                }
+                foreach x $highx {
+                    set score [r zscore zset $x]
+                    if {$score <= $max} {
+                        append err "Error, score for $x is $score <= $max\n"
+                    }
                 }
             }
-            foreach x $lowx {
-                set score [r zscore zset $x]
-                if {$score >= $min} {
-                    append err "Error, score for $x is $score >= $min\n"
-                }
-            }
-            foreach x $ok {
-                set score [r zscore zset $x]
-                if {$score < $min || $score > $max} {
-                    append err "Error, score for $x is $score outside $min-$max range\n"
-                }
-            }
-            foreach x $okx {
-                set score [r zscore zset $x]
-                if {$score <= $min || $score >= $max} {
-                    append err "Error, score for $x is $score outside $min-$max open range\n"
-                }
-            }
-            foreach x $high {
-                set score [r zscore zset $x]
-                if {$score < $max} {
-                    append err "Error, score for $x is $score < $max\n"
-                }
-            }
-            foreach x $highx {
-                set score [r zscore zset $x]
-                if {$score <= $max} {
-                    append err "Error, score for $x is $score <= $max\n"
-                }
-            }
-        }
-        set _ $err
-    } {}
+            set _ $err
+        } {}
+    }
 
     test {ZRANGEBYSCORE with LIMIT} {
         r del zset
@@ -356,47 +358,49 @@ start_server {} {
         list [r zinterstore zsetc 2 zseta zsetb aggregate max] [r zrange zsetc 0 -1 withscores]
     } {2 {b 2 c 3}}
     
-    test {ZSETs skiplist implementation backlink consistency test} {
-        set diff 0
-        set elements 10000
-        for {set j 0} {$j < $elements} {incr j} {
-            r zadd myzset [expr rand()] "Element-$j"
-            r zrem myzset "Element-[expr int(rand()*$elements)]"
-        }
-        set l1 [r zrange myzset 0 -1]
-        set l2 [r zrevrange myzset 0 -1]
-        for {set j 0} {$j < [llength $l1]} {incr j} {
-            if {[lindex $l1 $j] ne [lindex $l2 end-$j]} {
-                incr diff
+    tags {"slow"} {
+        test {ZSETs skiplist implementation backlink consistency test} {
+            set diff 0
+            set elements 10000
+            for {set j 0} {$j < $elements} {incr j} {
+                r zadd myzset [expr rand()] "Element-$j"
+                r zrem myzset "Element-[expr int(rand()*$elements)]"
             }
-        }
-        format $diff
-    } {0}
-
-    test {ZSETs ZRANK augmented skip list stress testing} {
-        set err {}
-        r del myzset
-        for {set k 0} {$k < 10000} {incr k} {
-            set i [expr {$k%1000}]
-            if {[expr rand()] < .2} {
-                r zrem myzset $i
-            } else {
-                set score [expr rand()]
-                r zadd myzset $score $i
-            }
-            set card [r zcard myzset]
-            if {$card > 0} {
-                set index [randomInt $card]
-                set ele [lindex [r zrange myzset $index $index] 0]
-                set rank [r zrank myzset $ele]
-                if {$rank != $index} {
-                    set err "$ele RANK is wrong! ($rank != $index)"
-                    break
+            set l1 [r zrange myzset 0 -1]
+            set l2 [r zrevrange myzset 0 -1]
+            for {set j 0} {$j < [llength $l1]} {incr j} {
+                if {[lindex $l1 $j] ne [lindex $l2 end-$j]} {
+                    incr diff
                 }
             }
-        }
-        set _ $err
-    } {}
+            format $diff
+        } {0}
+
+        test {ZSETs ZRANK augmented skip list stress testing} {
+            set err {}
+            r del myzset
+            for {set k 0} {$k < 10000} {incr k} {
+                set i [expr {$k%1000}]
+                if {[expr rand()] < .2} {
+                    r zrem myzset $i
+                } else {
+                    set score [expr rand()]
+                    r zadd myzset $score $i
+                }
+                set card [r zcard myzset]
+                if {$card > 0} {
+                    set index [randomInt $card]
+                    set ele [lindex [r zrange myzset $index $index] 0]
+                    set rank [r zrank myzset $ele]
+                    if {$rank != $index} {
+                        set err "$ele RANK is wrong! ($rank != $index)"
+                        break
+                    }
+                }
+            }
+            set _ $err
+        } {}
+    }
 
     test {ZSET element can't be set to nan with ZADD} {
         set e {}

From 7a6ae0a2b29f83523a6e65a61c7ec49cc9437781 Mon Sep 17 00:00:00 2001
From: Pieter Noordhuis <pcnoordhuis@gmail.com>
Date: Thu, 3 Jun 2010 00:06:58 +0200
Subject: [PATCH 07/12] scope res variable outside test

---
 tests/unit/sort.tcl | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/unit/sort.tcl b/tests/unit/sort.tcl
index 6ae2180d..16a02b3a 100644
--- a/tests/unit/sort.tcl
+++ b/tests/unit/sort.tcl
@@ -9,6 +9,7 @@ start_server {tags {"sort"}} {
     } {1 10 2 3}
 
     tags {"slow"} {
+        set res {}
         test {Create a random list and a random set} {
             set tosort {}
             array set seenrand {}
@@ -31,7 +32,6 @@ start_server {tags {"sort"}} {
                 lappend tosort [list $i $rint]
             }
             set sorted [lsort -index 1 -real $tosort]
-            set res {}
             for {set i 0} {$i < 10000} {incr i} {
                 lappend res [lindex $sorted $i 0]
             }

From 5713f06b339bd5f6d2d62092bb6adffd90367286 Mon Sep 17 00:00:00 2001
From: Pieter Noordhuis <pcnoordhuis@gmail.com>
Date: Thu, 3 Jun 2010 00:16:02 +0200
Subject: [PATCH 08/12] change how arguments are passed from the AOF tests

---
 tests/integration/aof.tcl | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/tests/integration/aof.tcl b/tests/integration/aof.tcl
index aca8a0f4..abcebe13 100644
--- a/tests/integration/aof.tcl
+++ b/tests/integration/aof.tcl
@@ -1,4 +1,4 @@
-set defaults [list [list appendonly yes] [list appendfilename appendonly.aof]]
+set defaults { appendonly {yes} appendfilename {appendonly.aof} }
 set server_path [tmpdir server.aof]
 set aof_path "$server_path/appendonly.aof"
 
@@ -16,8 +16,8 @@ proc create_aof {code} {
 
 proc start_server_aof {overrides code} {
     upvar defaults defaults srv srv server_path server_path
-    set _defaults $defaults
-    set srv [start_server {overrides [lappend _defaults $overrides]}]
+    set config [concat $defaults $overrides]
+    set srv [start_server [list overrides $config]]
     uplevel 1 $code
     kill_server $srv
 }

From 6b6f101c2761c5a9762723ae99a75dd0d2e009df Mon Sep 17 00:00:00 2001
From: Pieter Noordhuis <pcnoordhuis@gmail.com>
Date: Thu, 3 Jun 2010 00:16:10 +0200
Subject: [PATCH 09/12] tag more slow tests

---
 tests/unit/expire.tcl | 10 ++++++----
 tests/unit/other.tcl  | 28 +++++++++++++++-------------
 2 files changed, 21 insertions(+), 17 deletions(-)

diff --git a/tests/unit/expire.tcl b/tests/unit/expire.tcl
index 6b2fe747..d65df2f8 100644
--- a/tests/unit/expire.tcl
+++ b/tests/unit/expire.tcl
@@ -12,10 +12,12 @@ start_server {tags {"expire"}} {
         r get x
     } {foobar}
 
-    test {EXPIRE - After 6 seconds the key should no longer be here} {
-        after 6000
-        list [r get x] [r exists x]
-    } {{} 0}
+    tags {"slow"} {
+        test {EXPIRE - After 6 seconds the key should no longer be here} {
+            after 6000
+            list [r get x] [r exists x]
+        } {{} 0}
+    }
 
     test {EXPIRE - Delete on write policy} {
         r del x
diff --git a/tests/unit/other.tcl b/tests/unit/other.tcl
index 00d2dd46..a2e8ba9e 100644
--- a/tests/unit/other.tcl
+++ b/tests/unit/other.tcl
@@ -12,20 +12,22 @@ start_server {} {
         r save
     } {OK}
 
-    foreach fuzztype {binary alpha compr} {
-        test "FUZZ stresser with data model $fuzztype" {
-            set err 0
-            for {set i 0} {$i < 10000} {incr i} {
-                set fuzz [randstring 0 512 $fuzztype]
-                r set foo $fuzz
-                set got [r get foo]
-                if {$got ne $fuzz} {
-                    set err [list $fuzz $got]
-                    break
+    tags {"slow"} {
+        foreach fuzztype {binary alpha compr} {
+            test "FUZZ stresser with data model $fuzztype" {
+                set err 0
+                for {set i 0} {$i < 10000} {incr i} {
+                    set fuzz [randstring 0 512 $fuzztype]
+                    r set foo $fuzz
+                    set got [r get foo]
+                    if {$got ne $fuzz} {
+                        set err [list $fuzz $got]
+                        break
+                    }
                 }
-            }
-            set _ $err
-        } {0}
+                set _ $err
+            } {0}
+        }
     }
 
     test {BGSAVE} {

From f6fa411d6cffd59155f8afbacad8c17db74d100d Mon Sep 17 00:00:00 2001
From: Pieter Noordhuis <pcnoordhuis@gmail.com>
Date: Thu, 3 Jun 2010 00:25:32 +0200
Subject: [PATCH 10/12] make sure the config it returned when called without
 code

---
 tests/support/server.tcl | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/tests/support/server.tcl b/tests/support/server.tcl
index 551e24d1..07e5e8ad 100644
--- a/tests/support/server.tcl
+++ b/tests/support/server.tcl
@@ -236,11 +236,10 @@ proc start_server {options {code undefined}} {
             exit 1
         }
 
+        set ::tags [lrange $::tags 0 end-[llength $tags]]
         kill_server $srv
     } else {
+        set ::tags [lrange $::tags 0 end-[llength $tags]]
         set _ $srv
     }
-
-    # remove tags
-    set ::tags [lrange $::tags 0 end-[llength $tags]]
 }

From afbf59145aa50d50631c860b73374a0438708b1f Mon Sep 17 00:00:00 2001
From: Pieter Noordhuis <pcnoordhuis@gmail.com>
Date: Thu, 3 Jun 2010 00:26:39 +0200
Subject: [PATCH 11/12] tag test with sleep() as slow

---
 tests/unit/expire.tcl | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/tests/unit/expire.tcl b/tests/unit/expire.tcl
index d65df2f8..b80975b6 100644
--- a/tests/unit/expire.tcl
+++ b/tests/unit/expire.tcl
@@ -48,10 +48,12 @@ start_server {tags {"expire"}} {
         r get y
     } {foo}
 
-    test {SETEX - Wait for the key to expire} {
-        after 3000
-        r get y
-    } {}
+    tags {"slow"} {
+        test {SETEX - Wait for the key to expire} {
+            after 3000
+            r get y
+        } {}
+    }
 
     test {SETEX - Wrong time parameter} {
         catch {r setex z -10 foo} e

From 5a9fcb87cac31b70a9721cc88df4a929c14846fe Mon Sep 17 00:00:00 2001
From: Pieter Noordhuis <pcnoordhuis@gmail.com>
Date: Thu, 3 Jun 2010 00:27:09 +0200
Subject: [PATCH 12/12] tag memory leak check on kill server as "leaks"

---
 tests/support/server.tcl | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/tests/support/server.tcl b/tests/support/server.tcl
index 07e5e8ad..0c9f48ce 100644
--- a/tests/support/server.tcl
+++ b/tests/support/server.tcl
@@ -33,9 +33,11 @@ proc kill_server config {
     if {![dict exists $config "skipleaks"]} {
         catch {
             if {[string match {*Darwin*} [exec uname -a]]} {
-                test "Check for memory leaks (pid $pid)" {
-                    exec leaks $pid
-                } {*0 leaks*}
+                tags {"leaks"} {
+                    test "Check for memory leaks (pid $pid)" {
+                        exec leaks $pid
+                    } {*0 leaks*}
+                }
             }
         }
     }