Be less verbose in testing; improve error handling

diff --git a/tests/support/server.tcl b/tests/support/server.tcl
index 1507088e002e68d4d70e1627177a1a3b529b8f89..39038bd699cfadb60b273c8d1c386254d8a5e699 100644 (file)
--- a/tests/support/server.tcl
+++ b/tests/support/server.tcl
@@ -83,9 +83,13 @@ proc ping_server {host port} {
         }
         close $fd
     } e]} {
         }
         close $fd
     } e]} {

-        puts -nonewline "."
+        if {$::verbose} {
+            puts -nonewline "."
+        }

     } else {
     } else {

-        puts -nonewline "ok"
+        if {$::verbose} {
+            puts -nonewline "ok"
+        }

     }
     return $retval
 }
     }
     return $retval
 }


@@ -181,7 +185,10 @@ proc start_server {options {code undefined}} {
     set retrynum 20
     set serverisup 0
 
     set retrynum 20
     set serverisup 0
 

-    puts -nonewline "=== ($tags) Starting server ${::host}:${::port} "
+    if {$::verbose} {
+        puts -nonewline "=== ($tags) Starting server ${::host}:${::port} "
+    }
+

     after 10
     if {$code ne "undefined"} {
         while {[incr retrynum -1]} {
     after 10
     if {$code ne "undefined"} {
         while {[incr retrynum -1]} {


@@ -196,7 +203,10 @@ proc start_server {options {code undefined}} {
     } else {
         set serverisup 1
     }
     } else {
         set serverisup 1
     }

-    puts {}
+
+    if {$::verbose} {
+        puts ""
+    }

 
     if {!$serverisup} {
         error_and_quit $config_file [exec cat $stderr]
 
     if {!$serverisup} {
         error_and_quit $config_file [exec cat $stderr]


@@ -246,41 +256,34 @@ proc start_server {options {code undefined}} {
         reconnect
 
         # execute provided block
         reconnect
 
         # execute provided block

-        set curnum $::testnum
-        if {![catch { uplevel 1 $code } err]} {
-            # zero exit status is good
-            unset err
+        set num_tests $::num_tests
+        if {[catch { uplevel 1 $code } error]} {
+            set backtrace $::errorInfo
+
+            # Kill the server without checking for leaks
+            dict set srv "skipleaks" 1
+            kill_server $srv
+
+            # Print warnings from log
+            puts [format "\nLogged 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)"
+            }
+            puts ""
+
+            error $error $backtrace

         }
 
         }
 

-        if {$curnum == $::testnum} {
-            # don't check for leaks when no tests were executed
+        # Don't do the leak check when no tests were run
+        if {$num_tests == $::num_tests} {

             dict set srv "skipleaks" 1
         }
 
         # pop the server object
         set ::servers [lrange $::servers 0 end-1]
             dict set srv "skipleaks" 1
         }
 
         # pop the server object
         set ::servers [lrange $::servers 0 end-1]

-        
-        # 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 {[info exists err]} {
-            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
-            }
-        }

 
         set ::tags [lrange $::tags 0 end-[llength $tags]]
         kill_server $srv
 
         set ::tags [lrange $::tags 0 end-[llength $tags]]
         kill_server $srv

diff --git a/tests/support/test.tcl b/tests/support/test.tcl
index e801e1f228ea91946dd8d68ae4bfd722bcdcf52a..153ba1e3928315ce81c2e2975b087e27110c5b99 100644 (file)
--- a/tests/support/test.tcl
+++ b/tests/support/test.tcl
@@ -1,25 +1,23 @@
-set ::passed 0
-set ::failed 0
-set ::testnum 0
+set ::num_tests 0
+set ::num_passed 0
+set ::num_failed 0
+set ::tests_failed {}

 
 proc assert {condition} {
     if {![uplevel 1 expr $condition]} {
 
 proc assert {condition} {
     if {![uplevel 1 expr $condition]} {

-        puts "!! ERROR\nExpected '$value' to evaluate to true"
-        error "assertion"
+        error "assertion:Expected '$value' to be true"

     }
 }
 
 proc assert_match {pattern value} {
     if {![string match $pattern $value]} {
     }
 }
 
 proc assert_match {pattern value} {
     if {![string match $pattern $value]} {

-        puts "!! ERROR\nExpected '$value' to match '$pattern'"
-        error "assertion"
+        error "assertion:Expected '$value' to match '$pattern'"

     }
 }
 
 proc assert_equal {expected value} {
     if {$expected ne $value} {
     }
 }
 
 proc assert_equal {expected value} {
     if {$expected ne $value} {

-        puts "!! ERROR\nExpected '$value' to be equal to '$expected'"
-        error "assertion"
+        error "assertion:Expected '$value' to be equal to '$expected'"

     }
 }
 
     }
 }
 


@@ -27,8 +25,7 @@ proc assert_error {pattern code} {
     if {[catch {uplevel 1 $code} error]} {
         assert_match $pattern $error
     } else {
     if {[catch {uplevel 1 $code} error]} {
         assert_match $pattern $error
     } else {

-        puts "!! ERROR\nExpected an error but nothing was catched"
-        error "assertion"
+        error "assertion:Expected an error but nothing was catched"

     }
 }
 
     }
 }
 


@@ -47,7 +44,7 @@ proc assert_type {type key} {
     assert_equal $type [r type $key]
 }
 
     assert_equal $type [r type $key]
 }
 

-proc test {name code {okpattern notspecified}} {
+proc test {name code {okpattern undefined}} {

     # abort if tagged with a tag to deny
     foreach tag $::denytags {
         if {[lsearch $::tags $tag] >= 0} {
     # abort if tagged with a tag to deny
     foreach tag $::denytags {
         if {[lsearch $::tags $tag] >= 0} {


@@ -69,30 +66,62 @@ proc test {name code {okpattern notspecified}} {
         }
     }
 
         }
     }
 

-    incr ::testnum
-    puts -nonewline [format "#%03d %-68s " $::testnum $name]
-    flush stdout
+    incr ::num_tests
+    set details {}
+    lappend details $::curfile
+    lappend details $::tags
+    lappend details $name
+
+    if {$::verbose} {
+        puts -nonewline [format "#%03d %-68s " $::num_tests $name]
+        flush stdout
+    }
+

     if {[catch {set retval [uplevel 1 $code]} error]} {
     if {[catch {set retval [uplevel 1 $code]} error]} {

-        if {$error eq "assertion"} {
-            incr ::failed
+        if {[string match "assertion:*" $error]} {
+            set msg [string range $error 10 end]
+            lappend details $msg
+            lappend ::tests_failed $details
+
+            incr ::num_failed
+            if {$::verbose} {
+                puts "FAILED"
+                puts "$msg\n"
+            } else {
+                puts -nonewline "F"
+            }

         } else {
         } else {

-            puts "EXCEPTION"
-            puts "\nCaught error: $error"
-            error "exception"
+            # Re-raise, let handler up the stack take care of this.
+            error $error $::errorInfo

         }
     } else {
         }
     } else {

-        if {$okpattern eq "notspecified" || $okpattern eq $retval || [string match $okpattern $retval]} {
-            puts "PASSED"
-            incr ::passed
+        if {$okpattern eq "undefined" || $okpattern eq $retval || [string match $okpattern $retval]} {
+            incr ::num_passed
+            if {$::verbose} {
+                puts "PASSED"
+            } else {
+                puts -nonewline "."
+            }

         } else {
         } else {

-            puts "!! ERROR expected\n'$okpattern'\nbut got\n'$retval'"
-            incr ::failed
+            set msg "Expected '$okpattern' to equal or match '$retval'"
+            lappend details $msg
+            lappend ::tests_failed $details
+
+            incr ::num_failed
+            if {$::verbose} {
+                puts "FAILED"
+                puts "$msg\n"
+            } else {
+                puts -nonewline "F"
+            }

         }
     }
         }
     }

+    flush stdout
+

     if {$::traceleaks} {
         set output [exec leaks redis-server]
         if {![string match {*0 leaks*} $output]} {
     if {$::traceleaks} {
         set output [exec leaks redis-server]
         if {![string match {*0 leaks*} $output]} {

-            puts "--------- Test $::testnum LEAKED! --------"
+            puts "--- Test \"$name\" leaked! ---"

             puts $output
             exit 1
         }
             puts $output
             exit 1
         }

diff --git a/tests/support/util.tcl b/tests/support/util.tcl
index 93cb750f048f38d914bdf62c7525fe773728d494..a39a2134b5f5209cd60c338b432d9ec7477564b8 100644 (file)
--- a/tests/support/util.tcl
+++ b/tests/support/util.tcl
@@ -52,8 +52,10 @@ proc status {r property} {
 proc waitForBgsave r {
     while 1 {
         if {[status r bgsave_in_progress] eq 1} {
 proc waitForBgsave r {
     while 1 {
         if {[status r bgsave_in_progress] eq 1} {

-            puts -nonewline "\nWaiting for background save to finish... "
-            flush stdout
+            if {$::verbose} {
+                puts -nonewline "\nWaiting for background save to finish... "
+                flush stdout
+            }

             after 1000
         } else {
             break
             after 1000
         } else {
             break


@@ -64,8 +66,10 @@ proc waitForBgsave r {
 proc waitForBgrewriteaof r {
     while 1 {
         if {[status r bgrewriteaof_in_progress] eq 1} {
 proc waitForBgrewriteaof r {
     while 1 {
         if {[status r bgrewriteaof_in_progress] eq 1} {

-            puts -nonewline "\nWaiting for background AOF rewrite to finish... "
-            flush stdout
+            if {$::verbose} {
+                puts -nonewline "\nWaiting for background AOF rewrite to finish... "
+                flush stdout
+            }

             after 1000
         } else {
             break
             after 1000
         } else {
             break

diff --git a/tests/test_helper.tcl b/tests/test_helper.tcl
index 4c207f643cf8abfc23b3817754b85fc73d732378..1852fa7b5d7485473fab2f851def5e0f3148e723 100644 (file)
--- a/tests/test_helper.tcl
+++ b/tests/test_helper.tcl
@@ -13,13 +13,17 @@ set ::host 127.0.0.1
 set ::port 16379
 set ::traceleaks 0
 set ::valgrind 0
 set ::port 16379
 set ::traceleaks 0
 set ::valgrind 0

+set ::verbose 0

 set ::denytags {}
 set ::allowtags {}
 set ::external 0; # If "1" this means, we are running against external instance
 set ::file ""; # If set, runs only the tests in this comma separated list
 set ::denytags {}
 set ::allowtags {}
 set ::external 0; # If "1" this means, we are running against external instance
 set ::file ""; # If set, runs only the tests in this comma separated list

+set ::curfile ""; # Hold the filename of the current suite

 
 proc execute_tests name {
 
 proc execute_tests name {

-    source "tests/$name.tcl"
+    set path "tests/$name.tcl"
+    set ::curfile $path
+    source $path

 }
 
 # Setup a list to hold a stack of server configs. When calls to start_server
 }
 
 # Setup a list to hold a stack of server configs. When calls to start_server


@@ -147,9 +151,27 @@ proc main {} {
     }
 
     cleanup
     }
 
     cleanup

-    puts "\n[expr $::passed+$::failed] tests, $::passed passed, $::failed failed"
-    if {$::failed > 0} {
-        puts "\n*** WARNING!!! $::failed FAILED TESTS ***\n"
+    puts "\n[expr $::num_tests] tests, $::num_passed passed, $::num_failed failed\n"
+    if {$::num_failed > 0} {
+        set curheader ""
+        puts "Failures:"
+        foreach {test} $::tests_failed {
+            set header [lindex $test 0]
+            append header " ("
+            append header [join [lindex $test 1] ","]
+            append header ")"
+
+            if {$curheader ne $header} {
+                set curheader $header
+                puts "\n$curheader:"
+            }
+
+            set name [lindex $test 2]
+            set msg [lindex $test 3]
+            puts "- $name: $msg"
+        }
+
+        puts ""

         exit 1
     }
 }
         exit 1
     }
 }


@@ -177,6 +199,8 @@ for {set j 0} {$j < [llength $argv]} {incr j} {
     } elseif {$opt eq {--port}} {
         set ::port $arg
         incr j
     } elseif {$opt eq {--port}} {
         set ::port $arg
         incr j

+    } elseif {$opt eq {--verbose}} {
+        set ::verbose 1

     } else {
         puts "Wrong argument: $opt"
         exit 1
     } else {
         puts "Wrong argument: $opt"
         exit 1


@@ -187,7 +211,7 @@ if {[catch { main } err]} {
     if {[string length $err] > 0} {
         # only display error when not generated by the test suite
         if {$err ne "exception"} {
     if {[string length $err] > 0} {
         # only display error when not generated by the test suite
         if {$err ne "exception"} {

-            puts $err
+            puts $::errorInfo

         }
         exit 1
     }
         }
         exit 1
     }

diff --git a/tests/unit/sort.tcl b/tests/unit/sort.tcl
index 415585223b47a16a1b78f0998d69fe9d5fd28982..3a4c855f59fcf8bbca05cd3dcf083d680d0b266d 100644 (file)
--- a/tests/unit/sort.tcl
+++ b/tests/unit/sort.tcl
@@ -144,8 +144,10 @@ start_server {
                 set sorted [r sort tosort BY weight_* LIMIT 0 10]
             }
             set elapsed [expr [clock clicks -milliseconds]-$start]
                 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
+            if {$::verbose} {
+                puts -nonewline "\n  Average time to sort: [expr double($elapsed)/100] milliseconds "
+                flush stdout
+            }

         }
 
         test "SORT speed, $num element list BY hash field, 100 times" {
         }
 
         test "SORT speed, $num element list BY hash field, 100 times" {


@@ -154,8 +156,10 @@ start_server {
                 set sorted [r sort tosort BY wobj_*->weight LIMIT 0 10]
             }
             set elapsed [expr [clock clicks -milliseconds]-$start]
                 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
+            if {$::verbose} {
+                puts -nonewline "\n  Average time to sort: [expr double($elapsed)/100] milliseconds "
+                flush stdout
+            }

         }
 
         test "SORT speed, $num element list directly, 100 times" {
         }
 
         test "SORT speed, $num element list directly, 100 times" {


@@ -164,8 +168,10 @@ start_server {
                 set sorted [r sort tosort LIMIT 0 10]
             }
             set elapsed [expr [clock clicks -milliseconds]-$start]
                 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
+            if {$::verbose} {
+                puts -nonewline "\n  Average time to sort: [expr double($elapsed)/100] milliseconds "
+                flush stdout
+            }

         }
 
         test "SORT speed, $num element list BY <const>, 100 times" {
         }
 
         test "SORT speed, $num element list BY <const>, 100 times" {


@@ -174,8 +180,10 @@ start_server {
                 set sorted [r sort tosort BY nokey LIMIT 0 10]
             }
             set elapsed [expr [clock clicks -milliseconds]-$start]
                 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
+            if {$::verbose} {
+                puts -nonewline "\n  Average time to sort: [expr double($elapsed)/100] milliseconds "
+                flush stdout
+            }

         }
     }
 }
         }
     }
 }