list test further split into smaller units

[redis.git] / tests / test_helper.tcl

diff --git a/tests/test_helper.tcl b/tests/test_helper.tcl
index 4daf36866bd4936f3fcda8175aec4fc6edc81cd7..8629fa57ca9c14ffa4940b35ea904c0eeb389df3 100644 (file)
--- a/tests/test_helper.tcl
+++ b/tests/test_helper.tcl
@@ -15,6 +15,8 @@ set ::all_tests {
     unit/protocol
     unit/basic
     unit/type/list
     unit/protocol
     unit/basic
     unit/type/list

+    unit/type/list-2
+    unit/type/list-3

     unit/type/set
     unit/type/zset
     unit/type/hash
     unit/type/set
     unit/type/zset
     unit/type/hash


@@ -24,6 +26,8 @@ set ::all_tests {
     unit/cas
     unit/quit
     integration/replication
     unit/cas
     unit/quit
     integration/replication

+    integration/replication-2
+    integration/replication-3

     integration/aof
     unit/pubsub
     unit/slowlog
     integration/aof
     unit/pubsub
     unit/slowlog


@@ -166,9 +170,11 @@ proc test_server_main {} {
     }
 
     # Start the client instances
     }
 
     # Start the client instances

+    set ::clients_pids {}

     for {set j 0} {$j < $::numclients} {incr j} {
     for {set j 0} {$j < $::numclients} {incr j} {

-        exec tclsh8.5 [info script] {*}$::argv \
-            --client $port --port [expr {$::port+($j*10)}] &
+        set p [exec tclsh8.5 [info script] {*}$::argv \
+            --client $port --port [expr {$::port+($j*10)}] &]
+        lappend ::clients_pids $p

     }
 
     # Setup global state for the test server
     }
 
     # Setup global state for the test server


@@ -209,14 +215,29 @@ proc read_from_test_client fd {
     set bytes [gets $fd]
     set payload [read $fd $bytes]
     foreach {status data} $payload break
     set bytes [gets $fd]
     set payload [read $fd $bytes]
     foreach {status data} $payload break

-    puts "($fd) \[$status\]: $data"

     if {$status eq {ready}} {
     if {$status eq {ready}} {

+        puts "\[$status\]: $data"

         signal_idle_client $fd
     } elseif {$status eq {done}} {
         set elapsed [expr {[clock seconds]-$::clients_start_time($fd)}]
         signal_idle_client $fd
     } elseif {$status eq {done}} {
         set elapsed [expr {[clock seconds]-$::clients_start_time($fd)}]

-        puts "+++ [llength $::active_clients] units still in execution ($elapsed seconds)."
+        puts "\[[colorstr yellow $status]\]: $data ($elapsed seconds)"
+        puts "+++ [expr {[llength $::active_clients]-1}] units still in execution."

         lappend ::clients_time_history $elapsed $data
         signal_idle_client $fd
         lappend ::clients_time_history $elapsed $data
         signal_idle_client $fd

+    } elseif {$status eq {ok}} {
+        puts "\[[colorstr green $status]\]: $data"
+    } elseif {$status eq {err}} {
+        puts "\[[colorstr red $status]\]: $data"
+    } elseif {$status eq {exception}} {
+        puts "\[[colorstr red $status]\]: $data"
+        foreach p $::clients_pids {
+            catch {exec kill -9 $p}
+        }
+        exit 1
+    } elseif {$status eq {testing}} {
+        # No op
+    } else {
+        puts "\[$status\]: $data"

     }
 }
 
     }
 }
 


@@ -228,7 +249,7 @@ proc signal_idle_client fd {
         [lsearch -all -inline -not -exact $::active_clients $fd]
     # New unit to process?
     if {$::next_test != [llength $::all_tests]} {
         [lsearch -all -inline -not -exact $::active_clients $fd]
     # New unit to process?
     if {$::next_test != [llength $::all_tests]} {

-        puts "Spawing new test process for: [lindex $::all_tests $::next_test]"
+        puts [colorstr bold-white "Testing [lindex $::all_tests $::next_test]"]

         set ::clients_start_time($fd) [clock seconds]
         send_data_packet $fd run [lindex $::all_tests $::next_test]
         lappend ::active_clients $fd
         set ::clients_start_time($fd) [clock seconds]
         send_data_packet $fd run [lindex $::all_tests $::next_test]
         lappend ::active_clients $fd