diff options
Diffstat (limited to 'tests/support')
| -rw-r--r-- | tests/support/redis.tcl | 58 | ||||
| -rw-r--r-- | tests/support/response_transformers.tcl | 105 | ||||
| -rw-r--r-- | tests/support/server.tcl | 14 |
3 files changed, 172 insertions, 5 deletions
diff --git a/tests/support/redis.tcl b/tests/support/redis.tcl index 861e8bc27..53fa9fe91 100644 --- a/tests/support/redis.tcl +++ b/tests/support/redis.tcl @@ -28,6 +28,8 @@ package require Tcl 8.5 package provide redis 0.1 +source [file join [file dirname [info script]] "response_transformers.tcl"] + namespace eval redis {} set ::redis::id 0 array set ::redis::fd {} @@ -41,6 +43,11 @@ array set ::redis::tls {} array set ::redis::callback {} array set ::redis::state {} ;# State in non-blocking reply reading array set ::redis::statestack {} ;# Stack of states, for nested mbulks +array set ::redis::curr_argv {} ;# Remember the current argv, to be used in response_transformers.tcl +array set ::redis::testing_resp3 {} ;# Indicating if the current client is using RESP3 (only if the test is trying to test RESP3 specific behavior. It won't be on in case of force_resp3) + +set ::force_resp3 0 +set ::log_req_res 0 proc redis {{server 127.0.0.1} {port 6379} {defer 0} {tls 0} {tlsoptions {}} {readraw 0}} { if {$tls} { @@ -62,6 +69,8 @@ proc redis {{server 127.0.0.1} {port 6379} {defer 0} {tls 0} {tlsoptions {}} {re set ::redis::deferred($id) $defer set ::redis::readraw($id) $readraw set ::redis::reconnect($id) 0 + set ::redis::curr_argv($id) 0 + set ::redis::testing_resp3($id) 0 set ::redis::tls($id) $tls ::redis::redis_reset_state $id interp alias {} ::redis::redisHandle$id {} ::redis::__dispatch__ $id @@ -123,6 +132,20 @@ proc ::redis::__dispatch__raw__ {id method argv} { set fd $::redis::fd($id) } + # Transform HELLO 2 to HELLO 3 if force_resp3 + # All set the connection var testing_resp3 in case of HELLO 3 + if {[llength $argv] > 0 && [string compare -nocase $method "HELLO"] == 0} { + if {[lindex $argv 0] == 3} { + set ::redis::testing_resp3($id) 1 + } else { + set ::redis::testing_resp3($id) 0 + if {$::force_resp3} { + # If we are in force_resp3 we run HELLO 3 instead of HELLO 2 + lset argv 0 3 + } + } + } + set blocking $::redis::blocking($id) set deferred $::redis::deferred($id) if {$blocking == 0} { @@ -146,6 +169,7 @@ proc ::redis::__dispatch__raw__ {id method argv} { return -code error "I/O error reading reply" } + set ::redis::curr_argv($id) [concat $method $argv] if {!$deferred} { if {$blocking} { ::redis::redis_read_reply $id $fd @@ -200,6 +224,8 @@ proc ::redis::__method__close {id fd} { catch {unset ::redis::state($id)} catch {unset ::redis::statestack($id)} catch {unset ::redis::callback($id)} + catch {unset ::redis::curr_argv($id)} + catch {unset ::redis::testing_resp3($id)} catch {interp alias {} ::redis::redisHandle$id {}} } @@ -253,7 +279,7 @@ proc ::redis::redis_multi_bulk_read {id fd} { set err {} for {set i 0} {$i < $count} {incr i} { if {[catch { - lappend l [redis_read_reply $id $fd] + lappend l [redis_read_reply_logic $id $fd] } e] && $err eq {}} { set err $e } @@ -269,8 +295,8 @@ proc ::redis::redis_read_map {id fd} { set err {} for {set i 0} {$i < $count} {incr i} { if {[catch { - set k [redis_read_reply $id $fd] ; # key - set v [redis_read_reply $id $fd] ; # value + set k [redis_read_reply_logic $id $fd] ; # key + set v [redis_read_reply_logic $id $fd] ; # value dict set d $k $v } e] && $err eq {}} { set err $e @@ -296,13 +322,25 @@ proc ::redis::redis_read_bool fd { return -code error "Bad protocol, '$v' as bool type" } +proc ::redis::redis_read_double {id fd} { + set v [redis_read_line $fd] + # unlike many other DTs, there is a textual difference between double and a string with the same value, + # so we need to transform to double if we are testing RESP3 (i.e. some tests check that a + # double reply is "1.0" and not "1") + if {[should_transform_to_resp2 $id]} { + return $v + } else { + return [expr {double($v)}] + } +} + proc ::redis::redis_read_verbatim_str fd { set v [redis_bulk_read $fd] # strip the first 4 chars ("txt:") return [string range $v 4 end] } -proc ::redis::redis_read_reply {id fd} { +proc ::redis::redis_read_reply_logic {id fd} { if {$::redis::readraw($id)} { return [redis_read_line $fd] } @@ -314,7 +352,7 @@ proc ::redis::redis_read_reply {id fd} { : - ( - + {return [redis_read_line $fd]} - , {return [expr {double([redis_read_line $fd])}]} + , {return [redis_read_double $id $fd]} # {return [redis_read_bool $fd]} = {return [redis_read_verbatim_str $fd]} - {return -code error [redis_read_line $fd]} @@ -340,6 +378,11 @@ proc ::redis::redis_read_reply {id fd} { } } +proc ::redis::redis_read_reply {id fd} { + set response [redis_read_reply_logic $id $fd] + ::response_transformers::transform_response_if_needed $id $::redis::curr_argv($id) $response +} + proc ::redis::redis_reset_state id { set ::redis::state($id) [dict create buf {} mbulk -1 bulk -1 reply {}] set ::redis::statestack($id) {} @@ -416,3 +459,8 @@ proc ::redis::redis_readable {fd id} { } } } + +# when forcing resp3 some tests that rely on resp2 can fail, so we have to translate the resp3 response to resp2 +proc ::redis::should_transform_to_resp2 {id} { + return [expr {$::force_resp3 && !$::redis::testing_resp3($id)}] +} diff --git a/tests/support/response_transformers.tcl b/tests/support/response_transformers.tcl new file mode 100644 index 000000000..45b3cf8f2 --- /dev/null +++ b/tests/support/response_transformers.tcl @@ -0,0 +1,105 @@ +# Tcl client library - used by the Redis test +# Copyright (C) 2009-2023 Redis Ltd. +# Released under the BSD license like Redis itself +# +# This file contains a bunch of commands whose purpose is to transform +# a RESP3 response to RESP2 +# Why is it needed? +# When writing the reply_schema part in COMMAND DOCS we decided to use +# the existing tests in order to verify the schemas (see logreqres.c) +# The problem was that many tests were relying on the RESP2 structure +# of the response (e.g. HRANDFIELD WITHVALUES in RESP2: {f1 v1 f2 v2} +# vs. RESP3: {{f1 v1} {f2 v2}}). +# Instead of adjusting the tests to expect RESP3 responses (a lot of +# changes in many files) we decided to transform the response to RESP2 +# when running with --force-resp3 + +package require Tcl 8.5 + +namespace eval response_transformers {} + +# Transform a map response into an array of tuples (tuple = array with 2 elements) +# Used for XREAD[GROUP] +proc transfrom_map_to_tupple_array {argv response} { + set tuparray {} + foreach {key val} $response { + set tmp {} + lappend tmp $key + lappend tmp $val + lappend tuparray $tmp + } + return $tuparray +} + +# Transform an array of tuples to a flat array +proc transfrom_tuple_array_to_flat_array {argv response} { + set flatarray {} + foreach pair $response { + lappend flatarray {*}$pair + } + return $flatarray +} + +# With HRANDFIELD, we only need to transform the response if the request had WITHVALUES +# (otherwise the returned response is a flat array in both RESPs) +proc transfrom_hrandfield_command {argv response} { + foreach ele $argv { + if {[string compare -nocase $ele "WITHVALUES"] == 0} { + return [transfrom_tuple_array_to_flat_array $argv $response] + } + } + return $response +} + +# With some zset commands, we only need to transform the response if the request had WITHSCORES +# (otherwise the returned response is a flat array in both RESPs) +proc transfrom_zset_withscores_command {argv response} { + foreach ele $argv { + if {[string compare -nocase $ele "WITHSCORES"] == 0} { + return [transfrom_tuple_array_to_flat_array $argv $response] + } + } + return $response +} + +# With ZPOPMIN/ZPOPMAX, we only need to transform the response if the request had COUNT (3rd arg) +# (otherwise the returned response is a flat array in both RESPs) +proc transfrom_zpopmin_zpopmax {argv response} { + if {[llength $argv] == 3} { + return [transfrom_tuple_array_to_flat_array $argv $response] + } + return $response +} + +set ::trasformer_funcs { + XREAD transfrom_map_to_tupple_array + XREADGROUP transfrom_map_to_tupple_array + HRANDFIELD transfrom_hrandfield_command + ZRANDMEMBER transfrom_zset_withscores_command + ZRANGE transfrom_zset_withscores_command + ZRANGEBYSCORE transfrom_zset_withscores_command + ZRANGEBYLEX transfrom_zset_withscores_command + ZREVRANGE transfrom_zset_withscores_command + ZREVRANGEBYSCORE transfrom_zset_withscores_command + ZREVRANGEBYLEX transfrom_zset_withscores_command + ZUNION transfrom_zset_withscores_command + ZDIFF transfrom_zset_withscores_command + ZINTER transfrom_zset_withscores_command + ZPOPMIN transfrom_zpopmin_zpopmax + ZPOPMAX transfrom_zpopmin_zpopmax +} + +proc ::response_transformers::transform_response_if_needed {id argv response} { + if {![::redis::should_transform_to_resp2 $id] || $::redis::readraw($id)} { + return $response + } + + set key [string toupper [lindex $argv 0]] + if {![dict exists $::trasformer_funcs $key]} { + return $response + } + + set transform [dict get $::trasformer_funcs $key] + + return [$transform $argv $response] +} diff --git a/tests/support/server.tcl b/tests/support/server.tcl index a23224bd7..4c596290d 100644 --- a/tests/support/server.tcl +++ b/tests/support/server.tcl @@ -207,6 +207,12 @@ proc tags_acceptable {tags err_return} { } } + # some units mess with the client output buffer so we can't really use the req-res logging mechanism. + if {$::log_req_res && [lsearch $tags "logreqres:skip"] >= 0} { + set err "Not supported when running in log-req-res mode" + return 0 + } + if {$::external && [lsearch $tags "external:skip"] >= 0} { set err "Not supported on external server" return 0 @@ -511,6 +517,14 @@ proc start_server {options {code undefined}} { dict unset config $directive } + if {$::log_req_res} { + dict set config "req-res-logfile" "stdout.reqres" + } + + if {$::force_resp3} { + dict set config "client-default-resp" "3" + } + # write new configuration to temporary file set config_file [tmpfile redis.conf] create_server_config_file $config_file $config $config_lines |