Skip to content
Browse files

basic support to tag tests

  • Loading branch information...
1 parent c80ba69 commit 3c5b5e15d42be353b7b04992be48fce898e993c1 @pietern pietern committed Jun 2, 2010
Showing with 54 additions and 5 deletions.
  1. +28 −4 tests/support/server.tcl
  2. +21 −0 tests/support/test.tcl
  3. +2 −0 tests/test_helper.tcl
  4. +3 −1 tests/unit/basic.tcl
View
32 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]]
}
View
21 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
View
2 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"
View
4 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 {}

0 comments on commit 3c5b5e1

Please sign in to comment.
Something went wrong with that request. Please try again.