X-Git-Url: https://git.saurik.com/redis.git/blobdiff_plain/c14753cea16cc963363b0d3002dc94b33c1f2075..ff79ab71dbb1443edd4273e3b1022b76ccbd3ab5:/tests/support/redis.tcl diff --git a/tests/support/redis.tcl b/tests/support/redis.tcl index 0f4e401f..99415b64 100644 --- a/tests/support/redis.tcl +++ b/tests/support/redis.tcl @@ -32,35 +32,18 @@ namespace eval redis {} set ::redis::id 0 array set ::redis::fd {} array set ::redis::blocking {} +array set ::redis::deferred {} 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::bulkarg {} -array set ::redis::multibulkarg {} -# Flag commands requiring last argument as a bulk write operation -foreach redis_bulk_cmd { - set setnx rpush lpush lset lrem sadd srem sismember echo getset smove zadd zrem zscore zincrby append zrank zrevrank hget hdel hexists setex -} { - set ::redis::bulkarg($redis_bulk_cmd) {} -} - -# Flag commands requiring last argument as a bulk write operation -foreach redis_multibulk_cmd { - mset msetnx hset hsetnx hmset hmget -} { - set ::redis::multibulkarg($redis_multibulk_cmd) {} -} - -unset redis_bulk_cmd -unset redis_multibulk_cmd - -proc redis {{server 127.0.0.1} {port 6379}} { +proc redis {{server 127.0.0.1} {port 6379} {defer 0}} { set fd [socket $server $port] fconfigure $fd -translation binary set id [incr ::redis::id] set ::redis::fd($id) $fd set ::redis::blocking($id) 1 + set ::redis::deferred($id) $defer ::redis::redis_reset_state $id interp alias {} ::redis::redisHandle$id {} ::redis::__dispatch__ $id } @@ -68,6 +51,7 @@ proc redis {{server 127.0.0.1} {port 6379}} { proc ::redis::__dispatch__ {id method args} { set fd $::redis::fd($id) set blocking $::redis::blocking($id) + set deferred $::redis::deferred($id) if {$blocking == 0} { if {[llength $args] == 0} { error "Please provide a callback in non-blocking mode" @@ -76,33 +60,24 @@ proc ::redis::__dispatch__ {id method args} { set args [lrange $args 0 end-1] } if {[info command ::redis::__method__$method] eq {}} { - if {[info exists ::redis::bulkarg($method)]} { - set cmd "$method " - append cmd [join [lrange $args 0 end-1]] - append cmd " [string length [lindex $args end]]\r\n" - append cmd [lindex $args end] - ::redis::redis_writenl $fd $cmd - } elseif {[info exists ::redis::multibulkarg($method)]} { - set cmd "*[expr {[llength $args]+1}]\r\n" - append cmd "$[string length $method]\r\n$method\r\n" - foreach a $args { - append cmd "$[string length $a]\r\n$a\r\n" - } - ::redis::redis_write $fd $cmd - flush $fd - } else { - set cmd "$method " - append cmd [join $args] - ::redis::redis_writenl $fd $cmd + set cmd "*[expr {[llength $args]+1}]\r\n" + append cmd "$[string length $method]\r\n$method\r\n" + foreach a $args { + append cmd "$[string length $a]\r\n$a\r\n" } - if {$blocking} { - ::redis::redis_read_reply $fd - } else { - # Every well formed reply read will pop an element from this - # list and use it as a callback. So pipelining is supported - # in non blocking mode. - lappend ::redis::callback($id) $callback - fileevent $fd readable [list ::redis::redis_readable $fd $id] + ::redis::redis_write $fd $cmd + flush $fd + + if {!$deferred} { + if {$blocking} { + ::redis::redis_read_reply $fd + } else { + # Every well formed reply read will pop an element from this + # list and use it as a callback. So pipelining is supported + # in non blocking mode. + lappend ::redis::callback($id) $callback + fileevent $fd readable [list ::redis::redis_readable $fd $id] + } } } else { uplevel 1 [list ::redis::__method__$method $id $fd] $args @@ -114,6 +89,18 @@ proc ::redis::__method__blocking {id fd val} { fconfigure $fd -blocking $val } +proc ::redis::__method__read {id fd} { + ::redis::redis_read_reply $fd +} + +proc ::redis::__method__write {id fd buf} { + ::redis::redis_write $fd $buf +} + +proc ::redis::__method__flush {id fd} { + flush $fd +} + proc ::redis::__method__close {id fd} { catch {close $fd} catch {unset ::redis::fd($id)} @@ -155,9 +142,15 @@ proc ::redis::redis_multi_bulk_read fd { set count [redis_read_line $fd] if {$count == -1} return {} set l {} + set err {} for {set i 0} {$i < $count} {incr i} { - lappend l [redis_read_reply $fd] + if {[catch { + lappend l [redis_read_reply $fd] + } e] && $err eq {}} { + set err $e + } } + if {$err ne {}} {return -code error $err} return $l } @@ -173,7 +166,7 @@ proc ::redis::redis_read_reply fd { - {return -code error [redis_read_line $fd]} $ {redis_bulk_read $fd} * {redis_multi_bulk_read $fd} - default {return -code error "Bad protocol, $type as reply type byte"} + default {return -code error "Bad protocol, '$type' as reply type byte"} } }