tag test with sleep() as slow

[redis.git] / tests / support / test.tcl

diff --git a/tests/support/test.tcl b/tests/support/test.tcl
index c695c82fa30cb4e1f232ba51b679ae5c6e153186..d2674da19a28f8d202298341c52bcb80daefa2b2 100644 (file)
--- a/tests/support/test.tcl
+++ b/tests/support/test.tcl
@@ -3,11 +3,35 @@ set ::failed 0
 set ::testnum 0
 
 proc test {name code okpattern} {
 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] >= 0} {
+                incr matched
+            }
+        }
+        if {$matched < 1} {
+            return
+        }
+    }
+

     incr ::testnum
     incr ::testnum

-    # if {$::testnum < $::first || $::testnum > $::last} return

     puts -nonewline [format "#%03d %-68s " $::testnum $name]
     flush stdout
     puts -nonewline [format "#%03d %-68s " $::testnum $name]
     flush stdout

-    set retval [uplevel 1 $code]
+    if {[catch {set retval [uplevel 1 $code]} error]} {
+        puts "EXCEPTION"
+        puts "\nCaught error: $error"
+        error "exception"
+    }

     if {$okpattern eq $retval || [string match $okpattern $retval]} {
         puts "PASSED"
         incr ::passed
     if {$okpattern eq $retval || [string match $okpattern $retval]} {
         puts "PASSED"
         incr ::passed