diff --git a/tests/support/test.tcl b/tests/support/test.tcl index 2fe52f475..68180bea4 100644 --- a/tests/support/test.tcl +++ b/tests/support/test.tcl @@ -24,9 +24,11 @@ proc assert_no_match {pattern value} { } } -proc assert_match {pattern value {detail ""}} { +proc assert_match {pattern value {detail ""} {context ""}} { if {![string match $pattern $value]} { - set context "(context: [info frame -1])" + if {$context eq ""} { + set context "(context: [info frame -1])" + } error "assertion:Expected '$value' to match '$pattern' $context $detail" } } diff --git a/tests/test_helper.tcl b/tests/test_helper.tcl index 33d2f0fd8..3a612c8c2 100644 --- a/tests/test_helper.tcl +++ b/tests/test_helper.tcl @@ -857,9 +857,22 @@ proc read_from_replication_stream {s} { } proc assert_replication_stream {s patterns} { + set errors 0 + set values_list {} + set patterns_list {} for {set j 0} {$j < [llength $patterns]} {incr j} { - assert_match [lindex $patterns $j] [read_from_replication_stream $s] + set pattern [lindex $patterns $j] + lappend patterns_list $pattern + set value [read_from_replication_stream $s] + lappend values_list $value + if {![string match $pattern $value]} { incr errors } } + + if {$errors == 0} { return } + + set context [info frame -1] + close_replication_stream $s ;# for fast exit + assert_match $patterns_list $values_list "" $context } proc close_replication_stream {s} { diff --git a/tests/unit/expire.tcl b/tests/unit/expire.tcl index 22a9f73bb..5ee4488b3 100644 --- a/tests/unit/expire.tcl +++ b/tests/unit/expire.tcl @@ -628,6 +628,9 @@ start_server {tags {"expire"}} { } {-1} {needs:debug} test {GETEX propagate as to replica as PERSIST, DEL, or nothing} { + # In the above tests, many keys with random expiration times are set, flush + # the DBs to avoid active expiry kicking in and messing the replication streams. + r flushall set repl [attach_to_replication_stream] r set foo bar EX 100 r getex foo PERSIST