From 517f883150ad25ef1059d9f0022fcc8b62303652 Mon Sep 17 00:00:00 2001 From: songzhao Date: Tue, 15 Dec 2015 19:15:18 +0800 Subject: [PATCH] bugfix & add pikatests --- conf/pika.conf | 2 +- pikatests/TESTREAD | 3 + pikatests/pikatest.sh | 10 + pikatests/tests/assets/default.conf | 32 + pikatests/tests/assets/encodings.rdb | Bin 0 -> 667 bytes pikatests/tests/assets/hash-zipmap.rdb | Bin 0 -> 35 bytes pikatests/tests/helpers/bg_complex_data.tcl | 10 + pikatests/tests/helpers/gen_write_load.tcl | 15 + pikatests/tests/instances.tcl | 407 ++++++++ pikatests/tests/integration/aof-race.tcl | 35 + pikatests/tests/integration/aof.tcl | 236 +++++ .../convert-zipmap-hash-on-load.tcl | 35 + pikatests/tests/integration/rdb.tcl | 98 ++ pikatests/tests/integration/redis-cli.tcl | 208 ++++ pikatests/tests/integration/replication-2.tcl | 87 ++ pikatests/tests/integration/replication-3.tcl | 101 ++ pikatests/tests/integration/replication-4.tcl | 136 +++ .../tests/integration/replication-psync.tcl | 115 +++ pikatests/tests/integration/replication.tcl | 215 ++++ pikatests/tests/sentinel/run.tcl | 22 + pikatests/tests/sentinel/tests/00-base.tcl | 126 +++ .../tests/sentinel/tests/01-conf-update.tcl | 39 + .../tests/sentinel/tests/02-slaves-reconf.tcl | 84 ++ .../sentinel/tests/03-runtime-reconf.tcl | 1 + .../sentinel/tests/04-slave-selection.tcl | 5 + pikatests/tests/sentinel/tests/05-manual.tcl | 44 + .../sentinel/tests/includes/init-tests.tcl | 72 ++ pikatests/tests/sentinel/tmp/.gitignore | 2 + pikatests/tests/support/redis.tcl | 294 ++++++ pikatests/tests/support/server.tcl | 336 +++++++ pikatests/tests/support/test.tcl | 130 +++ pikatests/tests/support/tmpfile.tcl | 15 + pikatests/tests/support/util.tcl | 371 +++++++ pikatests/tests/test_helper.tcl | 545 ++++++++++ pikatests/tests/unit/aofrw.tcl | 210 ++++ pikatests/tests/unit/auth.tcl | 27 + pikatests/tests/unit/basic.tcl | 783 +++++++++++++++ pikatests/tests/unit/bitops.tcl | 341 +++++++ pikatests/tests/unit/dump.tcl | 142 +++ pikatests/tests/unit/expire.tcl | 201 ++++ pikatests/tests/unit/hyperloglog.tcl | 170 ++++ pikatests/tests/unit/introspection.tcl | 59 ++ pikatests/tests/unit/latency-monitor.tcl | 50 + pikatests/tests/unit/limits.tcl | 16 + pikatests/tests/unit/maxmemory.tcl | 144 +++ pikatests/tests/unit/memefficiency.tcl | 37 + pikatests/tests/unit/multi.tcl | 309 ++++++ pikatests/tests/unit/obuf-limits.tcl | 73 ++ pikatests/tests/unit/other.tcl | 245 +++++ pikatests/tests/unit/printver.tcl | 6 + pikatests/tests/unit/protocol.tcl | 117 +++ pikatests/tests/unit/pubsub.tcl | 390 ++++++++ pikatests/tests/unit/quit.tcl | 40 + pikatests/tests/unit/scan.tcl | 239 +++++ pikatests/tests/unit/scripting.tcl | 606 +++++++++++ pikatests/tests/unit/slowlog.tcl | 70 ++ pikatests/tests/unit/sort.tcl | 311 ++++++ pikatests/tests/unit/type/.zset.tcl.swp | Bin 0 -> 16384 bytes pikatests/tests/unit/type/hash.tcl | 470 +++++++++ pikatests/tests/unit/type/list-2.tcl | 44 + pikatests/tests/unit/type/list-3.tcl | 79 ++ pikatests/tests/unit/type/list-common.tcl | 5 + pikatests/tests/unit/type/list.tcl | 896 +++++++++++++++++ pikatests/tests/unit/type/set.tcl | 531 ++++++++++ pikatests/tests/unit/type/zset.tcl | 944 ++++++++++++++++++ src/pika.cc | 2 +- src/pika_conf.cc | 4 +- third/nemo | 2 +- 68 files changed, 11389 insertions(+), 5 deletions(-) create mode 100644 pikatests/TESTREAD create mode 100755 pikatests/pikatest.sh create mode 100644 pikatests/tests/assets/default.conf create mode 100644 pikatests/tests/assets/encodings.rdb create mode 100644 pikatests/tests/assets/hash-zipmap.rdb create mode 100644 pikatests/tests/helpers/bg_complex_data.tcl create mode 100644 pikatests/tests/helpers/gen_write_load.tcl create mode 100644 pikatests/tests/instances.tcl create mode 100644 pikatests/tests/integration/aof-race.tcl create mode 100644 pikatests/tests/integration/aof.tcl create mode 100644 pikatests/tests/integration/convert-zipmap-hash-on-load.tcl create mode 100644 pikatests/tests/integration/rdb.tcl create mode 100644 pikatests/tests/integration/redis-cli.tcl create mode 100644 pikatests/tests/integration/replication-2.tcl create mode 100644 pikatests/tests/integration/replication-3.tcl create mode 100644 pikatests/tests/integration/replication-4.tcl create mode 100644 pikatests/tests/integration/replication-psync.tcl create mode 100644 pikatests/tests/integration/replication.tcl create mode 100644 pikatests/tests/sentinel/run.tcl create mode 100644 pikatests/tests/sentinel/tests/00-base.tcl create mode 100644 pikatests/tests/sentinel/tests/01-conf-update.tcl create mode 100644 pikatests/tests/sentinel/tests/02-slaves-reconf.tcl create mode 100644 pikatests/tests/sentinel/tests/03-runtime-reconf.tcl create mode 100644 pikatests/tests/sentinel/tests/04-slave-selection.tcl create mode 100644 pikatests/tests/sentinel/tests/05-manual.tcl create mode 100644 pikatests/tests/sentinel/tests/includes/init-tests.tcl create mode 100644 pikatests/tests/sentinel/tmp/.gitignore create mode 100644 pikatests/tests/support/redis.tcl create mode 100644 pikatests/tests/support/server.tcl create mode 100644 pikatests/tests/support/test.tcl create mode 100644 pikatests/tests/support/tmpfile.tcl create mode 100644 pikatests/tests/support/util.tcl create mode 100644 pikatests/tests/test_helper.tcl create mode 100644 pikatests/tests/unit/aofrw.tcl create mode 100644 pikatests/tests/unit/auth.tcl create mode 100644 pikatests/tests/unit/basic.tcl create mode 100644 pikatests/tests/unit/bitops.tcl create mode 100644 pikatests/tests/unit/dump.tcl create mode 100644 pikatests/tests/unit/expire.tcl create mode 100644 pikatests/tests/unit/hyperloglog.tcl create mode 100644 pikatests/tests/unit/introspection.tcl create mode 100644 pikatests/tests/unit/latency-monitor.tcl create mode 100644 pikatests/tests/unit/limits.tcl create mode 100644 pikatests/tests/unit/maxmemory.tcl create mode 100644 pikatests/tests/unit/memefficiency.tcl create mode 100644 pikatests/tests/unit/multi.tcl create mode 100644 pikatests/tests/unit/obuf-limits.tcl create mode 100644 pikatests/tests/unit/other.tcl create mode 100644 pikatests/tests/unit/printver.tcl create mode 100644 pikatests/tests/unit/protocol.tcl create mode 100644 pikatests/tests/unit/pubsub.tcl create mode 100644 pikatests/tests/unit/quit.tcl create mode 100644 pikatests/tests/unit/scan.tcl create mode 100644 pikatests/tests/unit/scripting.tcl create mode 100644 pikatests/tests/unit/slowlog.tcl create mode 100644 pikatests/tests/unit/sort.tcl create mode 100644 pikatests/tests/unit/type/.zset.tcl.swp create mode 100644 pikatests/tests/unit/type/hash.tcl create mode 100644 pikatests/tests/unit/type/list-2.tcl create mode 100644 pikatests/tests/unit/type/list-3.tcl create mode 100644 pikatests/tests/unit/type/list-common.tcl create mode 100644 pikatests/tests/unit/type/list.tcl create mode 100644 pikatests/tests/unit/type/set.tcl create mode 100644 pikatests/tests/unit/type/zset.tcl diff --git a/conf/pika.conf b/conf/pika.conf index 242c1b5fd0..edfe2b0de4 100644 --- a/conf/pika.conf +++ b/conf/pika.conf @@ -29,7 +29,7 @@ target_file_size_base : 20971520 # Expire_logs_days expire_logs_days : 7 # Expire_logs_nums -expire_logs_nums : 7 +expire_logs_nums : 10 # Root_connection_num root_connection_num : 2 # Slowlog_log_slower_than diff --git a/pikatests/TESTREAD b/pikatests/TESTREAD new file mode 100644 index 0000000000..8455563cf7 --- /dev/null +++ b/pikatests/TESTREAD @@ -0,0 +1,3 @@ +1. 把pika可执行程序拷贝到./src目录里，更名为redis-server +2. 把pika配置文件拷贝到./tests/assets/目录里，更名为default.conf +3. 删除上次执行的db, log目录，执行 tclsh tests/test_helper.tcl --clients 1 --single unit/type/set 测试pika set, 也可以直接运行脚本./pikatest.sh set diff --git a/pikatests/pikatest.sh b/pikatests/pikatest.sh new file mode 100755 index 0000000000..9a77f464dd --- /dev/null +++ b/pikatests/pikatest.sh @@ -0,0 +1,10 @@ +#!/bin/bash +rm -rf /home/songzhao/develop/pika_test/redis/log +rm -rf /home/songzhao/develop/pika_test/redis/db +cp /home/songzhao/develop/pika/output/bin/pika /home/songzhao/develop/pika_test/redis/src/redis-server +#cp /home/songzhao/develop/pika/output/conf/pika.conf /home/songzhao/develop/pika_test/redis/tests/assets/default.conf + +tclsh tests/test_helper.tcl --clients 1 --single unit/type/$1 + +rm -rf /home/songzhao/develop/pika_test/redis/log +rm -rf /home/songzhao/develop/pika_test/redis/db diff --git a/pikatests/tests/assets/default.conf b/pikatests/tests/assets/default.conf new file mode 100644 index 0000000000..bf5f1e28cb --- /dev/null +++ b/pikatests/tests/assets/default.conf @@ -0,0 +1,32 @@ +# Pika port +port : 9221 +# Thread Number +thread_num : 16 +# Slave Thread Number +slave_thread_num : 7 +# Pika log path +log_path : ./log +# Pika glog level +log_level : 0 +# Pika db path +db_path : ./db/ +# Pika write_buffer_size +write_buffer_size : 268435456 +# Pika timeout +timeout : 60 +# Requirepass +requirepass : +# Dump Prefix +dump_prefix : +# daemonize [yes | no] +#daemonize : yes +# Dump Path +dump_path : ./dump/ +# Max Connection +maxconnection : 20000 +# the per file size of sst to compact, defalut is 2M +target_file_size_base : 20971520 +# Expire_logs_days +expire_logs_days : 1 +# Expire_logs_nums +expire_logs_nums : 20 diff --git a/pikatests/tests/assets/encodings.rdb b/pikatests/tests/assets/encodings.rdb new file mode 100644 index 0000000000000000000000000000000000000000..9fd9b705d16220065ee117a1c1c094f40fb122f2 GIT binary patch literal 667 zcmbVKu}UOC5UuKJ7oAzb-~v%NHW5S&dS+bpFfmX#Qw_|N?w&>$M|aur5EcU?;j)7> zGV&XY4SF>ZBR^rkz`zf1tzKQwOdP0r-Cfn)uU@~+^|g&HrPRU;knEK1xGIbhsS?(T zOp!5$Ql%uLiRxVU_K~%gGG1r2V@aAV)EAeQf1$=iXe|~B7q#x40{=g8Nhbr35aH0(af04| z31?FkfXdOIL*v>$`m`ZiW?H~$fQQSK0B})18Q{+2^#ErNo(A|lG8gy_c?x0;Mx(`{ zoa#1QiP|F?FVK2I8DyCB=mk$S8nlC&4|~3w8;|#Ox&QtGwHmXU=HND1)gUq}8+2xM zS?Yc@4yO2OwUpuPICQ~2@KI=m_~m`huJS+FRQ_l1RQDc;oztC1%JaPY56LTRm2LPS*34j0q literal 0 HcmV?d00001 diff --git a/pikatests/tests/helpers/bg_complex_data.tcl b/pikatests/tests/helpers/bg_complex_data.tcl new file mode 100644 index 0000000000..dffd7c6688 --- /dev/null +++ b/pikatests/tests/helpers/bg_complex_data.tcl @@ -0,0 +1,10 @@ +source tests/support/redis.tcl +source tests/support/util.tcl + +proc bg_complex_data {host port db ops} { + set r [redis $host $port] + $r select $db + createComplexDataset $r $ops +} + +bg_complex_data [lindex $argv 0] [lindex $argv 1] [lindex $argv 2] [lindex $argv 3] diff --git a/pikatests/tests/helpers/gen_write_load.tcl b/pikatests/tests/helpers/gen_write_load.tcl new file mode 100644 index 0000000000..6d1a345166 --- /dev/null +++ b/pikatests/tests/helpers/gen_write_load.tcl @@ -0,0 +1,15 @@ +source tests/support/redis.tcl + +proc gen_write_load {host port seconds} { + set start_time [clock seconds] + set r [redis $host $port 1] + $r select 9 + while 1 { + $r set [expr rand()] [expr rand()] + if {[clock seconds]-$start_time > $seconds} { + exit 0 + } + } +} + +gen_write_load [lindex $argv 0] [lindex $argv 1] [lindex $argv 2] diff --git a/pikatests/tests/instances.tcl b/pikatests/tests/instances.tcl new file mode 100644 index 0000000000..426508f33a --- /dev/null +++ b/pikatests/tests/instances.tcl @@ -0,0 +1,407 @@ +# Multi-instance test framework. +# This is used in order to test Sentinel and Redis Cluster, and provides +# basic capabilities for spawning and handling N parallel Redis / Sentinel +# instances. +# +# Copyright (C) 2014 Salvatore Sanfilippo antirez@gmail.com +# This software is released under the BSD License. See the COPYING file for +# more information. + +package require Tcl 8.5 + +set tcl_precision 17 +source ../support/redis.tcl +source ../support/util.tcl +source ../support/server.tcl +source ../support/test.tcl + +set ::verbose 0 +set ::pause_on_error 0 +set ::simulate_error 0 +set ::sentinel_instances {} +set ::redis_instances {} +set ::sentinel_base_port 20000 +set ::redis_base_port 30000 +set ::pids {} ; # We kill everything at exit +set ::dirs {} ; # We remove all the temp dirs at exit +set ::run_matching {} ; # If non empty, only tests matching pattern are run. + +if {[catch {cd tmp}]} { + puts "tmp directory not found." + puts "Please run this test from the Redis source root." + exit 1 +} + +# Spawn a redis or sentinel instance, depending on 'type'. +proc spawn_instance {type base_port count {conf {}}} { + for {set j 0} {$j < $count} {incr j} { + set port [find_available_port $base_port] + incr base_port + puts "Starting $type #$j at port $port" + + # Create a directory for this instance. + set dirname "${type}_${j}" + lappend ::dirs $dirname + catch {exec rm -rf $dirname} + file mkdir $dirname + + # Write the instance config file. + set cfgfile [file join $dirname $type.conf] + set cfg [open $cfgfile w] + puts $cfg "port $port" + puts $cfg "dir ./$dirname" + puts $cfg "logfile log.txt" + # Add additional config files + foreach directive $conf { + puts $cfg $directive + } + close $cfg + + # Finally exec it and remember the pid for later cleanup. + if {$type eq "redis"} { + set prgname redis-server + } elseif {$type eq "sentinel"} { + set prgname redis-sentinel + } else { + error "Unknown instance type." + } + set pid [exec ../../../src/${prgname} $cfgfile &] + lappend ::pids $pid + + # Check availability + if {[server_is_up 127.0.0.1 $port 100] == 0} { + abort_sentinel_test "Problems starting $type #$j: ping timeout" + } + + # Push the instance into the right list + set link [redis 127.0.0.1 $port] + $link reconnect 1 + lappend ::${type}_instances [list \ + pid $pid \ + host 127.0.0.1 \ + port $port \ + link $link \ + ] + } +} + +proc cleanup {} { + puts "Cleaning up..." + foreach pid $::pids { + catch {exec kill -9 $pid} + } + foreach dir $::dirs { + catch {exec rm -rf $dir} + } +} + +proc abort_sentinel_test msg { + puts "WARNING: Aborting the test." + puts ">>>>>>>> $msg" + cleanup + exit 1 +} + +proc parse_options {} { + for {set j 0} {$j < [llength $::argv]} {incr j} { + set opt [lindex $::argv $j] + set val [lindex $::argv [expr $j+1]] + if {$opt eq "--single"} { + incr j + set ::run_matching "*${val}*" + } elseif {$opt eq "--pause-on-error"} { + set ::pause_on_error 1 + } elseif {$opt eq "--fail"} { + set ::simulate_error 1 + } elseif {$opt eq "--help"} { + puts "Hello, I'm sentinel.tcl and I run Sentinel unit tests." + puts "\nOptions:" + puts "--single Only runs tests specified by pattern." + puts "--pause-on-error Pause for manual inspection on error." + puts "--fail Simulate a test failure." + puts "--help Shows this help." + exit 0 + } else { + puts "Unknown option $opt" + exit 1 + } + } +} + +# If --pause-on-error option was passed at startup this function is called +# on error in order to give the developer a chance to understand more about +# the error condition while the instances are still running. +proc pause_on_error {} { + puts "" + puts [colorstr yellow "*** Please inspect the error now ***"] + puts "\nType \"continue\" to resume the test, \"help\" for help screen.\n" + while 1 { + puts -nonewline "> " + flush stdout + set line [gets stdin] + set argv [split $line " "] + set cmd [lindex $argv 0] + if {$cmd eq {continue}} { + break + } elseif {$cmd eq {show-redis-logs}} { + set count 10 + if {[lindex $argv 1] ne {}} {set count [lindex $argv 1]} + foreach_redis_id id { + puts "=== REDIS $id ====" + puts [exec tail -$count redis_$id/log.txt] + puts "---------------------\n" + } + } elseif {$cmd eq {show-sentinel-logs}} { + set count 10 + if {[lindex $argv 1] ne {}} {set count [lindex $argv 1]} + foreach_sentinel_id id { + puts "=== SENTINEL $id ====" + puts [exec tail -$count sentinel_$id/log.txt] + puts "---------------------\n" + } + } elseif {$cmd eq {ls}} { + foreach_redis_id id { + puts -nonewline "Redis $id" + set errcode [catch { + set str {} + append str "@[RI $id tcp_port]: " + append str "[RI $id role] " + if {[RI $id role] eq {slave}} { + append str "[RI $id master_host]:[RI $id master_port]" + } + set str + } retval] + if {$errcode} { + puts " -- $retval" + } else { + puts $retval + } + } + foreach_sentinel_id id { + puts -nonewline "Sentinel $id" + set errcode [catch { + set str {} + append str "@[SI $id tcp_port]: " + append str "[join [S $id sentinel get-master-addr-by-name mymaster]]" + set str + } retval] + if {$errcode} { + puts " -- $retval" + } else { + puts $retval + } + } + } elseif {$cmd eq {help}} { + puts "ls List Sentinel and Redis instances." + puts "show-sentinel-logs \[N\] Show latest N lines of logs." + puts "show-redis-logs \[N\] Show latest N lines of logs." + puts "S cmd ... arg Call command in Sentinel ." + puts "R cmd ... arg Call command in Redis ." + puts "SI Show Sentinel INFO ." + puts "RI Show Sentinel INFO ." + puts "continue Resume test." + } else { + set errcode [catch {eval $line} retval] + if {$retval ne {}} {puts "$retval"} + } + } +} + +# We redefine 'test' as for Sentinel we don't use the server-client +# architecture for the test, everything is sequential. +proc test {descr code} { + set ts [clock format [clock seconds] -format %H:%M:%S] + puts -nonewline "$ts> $descr: " + flush stdout + + if {[catch {set retval [uplevel 1 $code]} error]} { + if {[string match "assertion:*" $error]} { + set msg [string range $error 10 end] + puts [colorstr red $msg] + if {$::pause_on_error} pause_on_error + puts "(Jumping to next unit after error)" + return -code continue + } else { + # Re-raise, let handler up the stack take care of this. + error $error $::errorInfo + } + } else { + puts [colorstr green OK] + } +} + +proc run_tests {} { + set tests [lsort [glob ../tests/*]] + foreach test $tests { + if {$::run_matching ne {} && [string match $::run_matching $test] == 0} { + continue + } + if {[file isdirectory $test]} continue + puts [colorstr yellow "Testing unit: [lindex [file split $test] end]"] + source $test + } +} + +# The "S" command is used to interact with the N-th Sentinel. +# The general form is: +# +# S command arg arg arg ... +# +# Example to ping the Sentinel 0 (first instance): S 0 PING +proc S {n args} { + set s [lindex $::sentinel_instances $n] + [dict get $s link] {*}$args +} + +# Like R but to chat with Redis instances. +proc R {n args} { + set r [lindex $::redis_instances $n] + [dict get $r link] {*}$args +} + +proc get_info_field {info field} { + set fl [string length $field] + append field : + foreach line [split $info "\n"] { + set line [string trim $line "\r\n "] + if {[string range $line 0 $fl] eq $field} { + return [string range $line [expr {$fl+1}] end] + } + } + return {} +} + +proc SI {n field} { + get_info_field [S $n info] $field +} + +proc RI {n field} { + get_info_field [R $n info] $field +} + +# Iterate over IDs of sentinel or redis instances. +proc foreach_instance_id {instances idvar code} { + upvar 1 $idvar id + for {set id 0} {$id < [llength $instances]} {incr id} { + set errcode [catch {uplevel 1 $code} result] + if {$errcode == 1} { + error $result $::errorInfo $::errorCode + } elseif {$errcode == 4} { + continue + } elseif {$errcode == 3} { + break + } elseif {$errcode != 0} { + return -code $errcode $result + } + } +} + +proc foreach_sentinel_id {idvar code} { + set errcode [catch {uplevel 1 [list foreach_instance_id $::sentinel_instances $idvar $code]} result] + return -code $errcode $result +} + +proc foreach_redis_id {idvar code} { + set errcode [catch {uplevel 1 [list foreach_instance_id $::redis_instances $idvar $code]} result] + return -code $errcode $result +} + +# Get the specific attribute of the specified instance type, id. +proc get_instance_attrib {type id attrib} { + dict get [lindex [set ::${type}_instances] $id] $attrib +} + +# Set the specific attribute of the specified instance type, id. +proc set_instance_attrib {type id attrib newval} { + set d [lindex [set ::${type}_instances] $id] + dict set d $attrib $newval + lset ::${type}_instances $id $d +} + +# Create a master-slave cluster of the given number of total instances. +# The first instance "0" is the master, all others are configured as +# slaves. +proc create_redis_master_slave_cluster n { + foreach_redis_id id { + if {$id == 0} { + # Our master. + R $id slaveof no one + R $id flushall + } elseif {$id < $n} { + R $id slaveof [get_instance_attrib redis 0 host] \ + [get_instance_attrib redis 0 port] + } else { + # Instances not part of the cluster. + R $id slaveof no one + } + } + # Wait for all the slaves to sync. + wait_for_condition 1000 50 { + [RI 0 connected_slaves] == ($n-1) + } else { + fail "Unable to create a master-slaves cluster." + } +} + +proc get_instance_id_by_port {type port} { + foreach_${type}_id id { + if {[get_instance_attrib $type $id port] == $port} { + return $id + } + } + fail "Instance $type port $port not found." +} + +# Kill an instance of the specified type/id with SIGKILL. +# This function will mark the instance PID as -1 to remember that this instance +# is no longer running and will remove its PID from the list of pids that +# we kill at cleanup. +# +# The instance can be restarted with restart-instance. +proc kill_instance {type id} { + set pid [get_instance_attrib $type $id pid] + if {$pid == -1} { + error "You tried to kill $type $id twice." + } + exec kill -9 $pid + set_instance_attrib $type $id pid -1 + set_instance_attrib $type $id link you_tried_to_talk_with_killed_instance + + # Remove the PID from the list of pids to kill at exit. + set ::pids [lsearch -all -inline -not -exact $::pids $pid] +} + +# Return true of the instance of the specified type/id is killed. +proc instance_is_killed {type id} { + set pid [get_instance_attrib $type $id pid] + expr {$pid == -1} +} + +# Restart an instance previously killed by kill_instance +proc restart_instance {type id} { + set dirname "${type}_${id}" + set cfgfile [file join $dirname $type.conf] + set port [get_instance_attrib $type $id port] + + # Execute the instance with its old setup and append the new pid + # file for cleanup. + if {$type eq "redis"} { + set prgname redis-server + } else { + set prgname redis-sentinel + } + set pid [exec ../../../src/${prgname} $cfgfile &] + set_instance_attrib $type $id pid $pid + lappend ::pids $pid + + # Check that the instance is running + if {[server_is_up 127.0.0.1 $port 100] == 0} { + abort_sentinel_test "Problems starting $type #$id: ping timeout" + } + + # Connect with it with a fresh link + set link [redis 127.0.0.1 $port] + $link reconnect 1 + set_instance_attrib $type $id link $link +} + diff --git a/pikatests/tests/integration/aof-race.tcl b/pikatests/tests/integration/aof-race.tcl new file mode 100644 index 0000000000..207f207393 --- /dev/null +++ b/pikatests/tests/integration/aof-race.tcl @@ -0,0 +1,35 @@ +set defaults { appendonly {yes} appendfilename {appendonly.aof} } +set server_path [tmpdir server.aof] +set aof_path "$server_path/appendonly.aof" + +proc start_server_aof {overrides code} { + upvar defaults defaults srv srv server_path server_path + set config [concat $defaults $overrides] + start_server [list overrides $config] $code +} + +tags {"aof"} { + # Specific test for a regression where internal buffers were not properly + # cleaned after a child responsible for an AOF rewrite exited. This buffer + # was subsequently appended to the new AOF, resulting in duplicate commands. + start_server_aof [list dir $server_path] { + set client [redis [srv host] [srv port]] + set bench [open "|src/redis-benchmark -q -p [srv port] -c 20 -n 20000 incr foo" "r+"] + after 100 + + # Benchmark should be running by now: start background rewrite + $client bgrewriteaof + + # Read until benchmark pipe reaches EOF + while {[string length [read $bench]] > 0} {} + + # Check contents of foo + assert_equal 20000 [$client get foo] + } + + # Restart server to replay AOF + start_server_aof [list dir $server_path] { + set client [redis [srv host] [srv port]] + assert_equal 20000 [$client get foo] + } +} diff --git a/pikatests/tests/integration/aof.tcl b/pikatests/tests/integration/aof.tcl new file mode 100644 index 0000000000..7ea70943c6 --- /dev/null +++ b/pikatests/tests/integration/aof.tcl @@ -0,0 +1,236 @@ +set defaults { appendonly {yes} appendfilename {appendonly.aof} } +set server_path [tmpdir server.aof] +set aof_path "$server_path/appendonly.aof" + +proc append_to_aof {str} { + upvar fp fp + puts -nonewline $fp $str +} + +proc create_aof {code} { + upvar fp fp aof_path aof_path + set fp [open $aof_path w+] + uplevel 1 $code + close $fp +} + +proc start_server_aof {overrides code} { + upvar defaults defaults srv srv server_path server_path + set config [concat $defaults $overrides] + set srv [start_server [list overrides $config]] + uplevel 1 $code + kill_server $srv +} + +tags {"aof"} { + ## Server can start when aof-load-truncated is set to yes and AOF + ## is truncated, with an incomplete MULTI block. + create_aof { + append_to_aof [formatCommand set foo hello] + append_to_aof [formatCommand multi] + append_to_aof [formatCommand set bar world] + } + + start_server_aof [list dir $server_path aof-load-truncated yes] { + test "Unfinished MULTI: Server should start if load-truncated is yes" { + assert_equal 1 [is_alive $srv] + } + } + + ## Should also start with truncated AOF without incomplete MULTI block. + create_aof { + append_to_aof [formatCommand incr foo] + append_to_aof [formatCommand incr foo] + append_to_aof [formatCommand incr foo] + append_to_aof [formatCommand incr foo] + append_to_aof [formatCommand incr foo] + append_to_aof [string range [formatCommand incr foo] 0 end-1] + } + + start_server_aof [list dir $server_path aof-load-truncated yes] { + test "Short read: Server should start if load-truncated is yes" { + assert_equal 1 [is_alive $srv] + } + + set client [redis [dict get $srv host] [dict get $srv port]] + + test "Truncated AOF loaded: we expect foo to be equal to 5" { + assert {[$client get foo] eq "5"} + } + + test "Append a new command after loading an incomplete AOF" { + $client incr foo + } + } + + # Now the AOF file is expected to be correct + start_server_aof [list dir $server_path aof-load-truncated yes] { + test "Short read + command: Server should start" { + assert_equal 1 [is_alive $srv] + } + + set client [redis [dict get $srv host] [dict get $srv port]] + + test "Truncated AOF loaded: we expect foo to be equal to 6 now" { + assert {[$client get foo] eq "6"} + } + } + + ## Test that the server exits when the AOF contains a format error + create_aof { + append_to_aof [formatCommand set foo hello] + append_to_aof "!!!" + append_to_aof [formatCommand set foo hello] + } + + start_server_aof [list dir $server_path aof-load-truncated yes] { + test "Bad format: Server should have logged an error" { + set pattern "*Bad file format reading the append only file*" + set retry 10 + while {$retry} { + set result [exec tail -n1 < [dict get $srv stdout]] + if {[string match $pattern $result]} { + break + } + incr retry -1 + after 1000 + } + if {$retry == 0} { + error "assertion:expected error not found on config file" + } + } + } + + ## Test the server doesn't start when the AOF contains an unfinished MULTI + create_aof { + append_to_aof [formatCommand set foo hello] + append_to_aof [formatCommand multi] + append_to_aof [formatCommand set bar world] + } + + start_server_aof [list dir $server_path aof-load-truncated no] { + test "Unfinished MULTI: Server should have logged an error" { + set pattern "*Unexpected end of file reading the append only file*" + set retry 10 + while {$retry} { + set result [exec tail -n1 < [dict get $srv stdout]] + if {[string match $pattern $result]} { + break + } + incr retry -1 + after 1000 + } + if {$retry == 0} { + error "assertion:expected error not found on config file" + } + } + } + + ## Test that the server exits when the AOF contains a short read + create_aof { + append_to_aof [formatCommand set foo hello] + append_to_aof [string range [formatCommand set bar world] 0 end-1] + } + + start_server_aof [list dir $server_path aof-load-truncated no] { + test "Short read: Server should have logged an error" { + set pattern "*Unexpected end of file reading the append only file*" + set retry 10 + while {$retry} { + set result [exec tail -n1 < [dict get $srv stdout]] + if {[string match $pattern $result]} { + break + } + incr retry -1 + after 1000 + } + if {$retry == 0} { + error "assertion:expected error not found on config file" + } + } + } + + ## Test that redis-check-aof indeed sees this AOF is not valid + test "Short read: Utility should confirm the AOF is not valid" { + catch { + exec src/redis-check-aof $aof_path + } result + assert_match "*not valid*" $result + } + + test "Short read: Utility should be able to fix the AOF" { + set result [exec src/redis-check-aof --fix $aof_path << "y\n"] + assert_match "*Successfully truncated AOF*" $result + } + + ## Test that the server can be started using the truncated AOF + start_server_aof [list dir $server_path aof-load-truncated no] { + test "Fixed AOF: Server should have been started" { + assert_equal 1 [is_alive $srv] + } + + test "Fixed AOF: Keyspace should contain values that were parseable" { + set client [redis [dict get $srv host] [dict get $srv port]] + wait_for_condition 50 100 { + [catch {$client ping} e] == 0 + } else { + fail "Loading DB is taking too much time." + } + assert_equal "hello" [$client get foo] + assert_equal "" [$client get bar] + } + } + + ## Test that SPOP (that modifies the client's argc/argv) is correctly free'd + create_aof { + append_to_aof [formatCommand sadd set foo] + append_to_aof [formatCommand sadd set bar] + append_to_aof [formatCommand spop set] + } + + start_server_aof [list dir $server_path aof-load-truncated no] { + test "AOF+SPOP: Server should have been started" { + assert_equal 1 [is_alive $srv] + } + + test "AOF+SPOP: Set should have 1 member" { + set client [redis [dict get $srv host] [dict get $srv port]] + wait_for_condition 50 100 { + [catch {$client ping} e] == 0 + } else { + fail "Loading DB is taking too much time." + } + assert_equal 1 [$client scard set] + } + } + + ## Test that EXPIREAT is loaded correctly + create_aof { + append_to_aof [formatCommand rpush list foo] + append_to_aof [formatCommand expireat list 1000] + append_to_aof [formatCommand rpush list bar] + } + + start_server_aof [list dir $server_path aof-load-truncated no] { + test "AOF+EXPIRE: Server should have been started" { + assert_equal 1 [is_alive $srv] + } + + test "AOF+EXPIRE: List should be empty" { + set client [redis [dict get $srv host] [dict get $srv port]] + wait_for_condition 50 100 { + [catch {$client ping} e] == 0 + } else { + fail "Loading DB is taking too much time." + } + assert_equal 0 [$client llen list] + } + } + + start_server {overrides {appendonly {yes} appendfilename {appendonly.aof}}} { + test {Redis should not try to convert DEL into EXPIREAT for EXPIRE -1} { + r set x 10 + r expire x -1 + } + } +} diff --git a/pikatests/tests/integration/convert-zipmap-hash-on-load.tcl b/pikatests/tests/integration/convert-zipmap-hash-on-load.tcl new file mode 100644 index 0000000000..cf3577f284 --- /dev/null +++ b/pikatests/tests/integration/convert-zipmap-hash-on-load.tcl @@ -0,0 +1,35 @@ +# Copy RDB with zipmap encoded hash to server path +set server_path [tmpdir "server.convert-zipmap-hash-on-load"] + +exec cp -f tests/assets/hash-zipmap.rdb $server_path +start_server [list overrides [list "dir" $server_path "dbfilename" "hash-zipmap.rdb"]] { + test "RDB load zipmap hash: converts to ziplist" { + r select 0 + + assert_match "*ziplist*" [r debug object hash] + assert_equal 2 [r hlen hash] + assert_match {v1 v2} [r hmget hash f1 f2] + } +} + +exec cp -f tests/assets/hash-zipmap.rdb $server_path +start_server [list overrides [list "dir" $server_path "dbfilename" "hash-zipmap.rdb" "hash-max-ziplist-entries" 1]] { + test "RDB load zipmap hash: converts to hash table when hash-max-ziplist-entries is exceeded" { + r select 0 + + assert_match "*hashtable*" [r debug object hash] + assert_equal 2 [r hlen hash] + assert_match {v1 v2} [r hmget hash f1 f2] + } +} + +exec cp -f tests/assets/hash-zipmap.rdb $server_path +start_server [list overrides [list "dir" $server_path "dbfilename" "hash-zipmap.rdb" "hash-max-ziplist-value" 1]] { + test "RDB load zipmap hash: converts to hash table when hash-max-ziplist-value is exceeded" { + r select 0 + + assert_match "*hashtable*" [r debug object hash] + assert_equal 2 [r hlen hash] + assert_match {v1 v2} [r hmget hash f1 f2] + } +} diff --git a/pikatests/tests/integration/rdb.tcl b/pikatests/tests/integration/rdb.tcl new file mode 100644 index 0000000000..71876a6edc --- /dev/null +++ b/pikatests/tests/integration/rdb.tcl @@ -0,0 +1,98 @@ +set server_path [tmpdir "server.rdb-encoding-test"] + +# Copy RDB with different encodings in server path +exec cp tests/assets/encodings.rdb $server_path + +start_server [list overrides [list "dir" $server_path "dbfilename" "encodings.rdb"]] { + test "RDB encoding loading test" { + r select 0 + csvdump r + } {"compressible","string","aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" +"hash","hash","a","1","aa","10","aaa","100","b","2","bb","20","bbb","200","c","3","cc","30","ccc","300","ddd","400","eee","5000000000", +"hash_zipped","hash","a","1","b","2","c","3", +"list","list","1","2","3","a","b","c","100000","6000000000","1","2","3","a","b","c","100000","6000000000","1","2","3","a","b","c","100000","6000000000", +"list_zipped","list","1","2","3","a","b","c","100000","6000000000", +"number","string","10" +"set","set","1","100000","2","3","6000000000","a","b","c", +"set_zipped_1","set","1","2","3","4", +"set_zipped_2","set","100000","200000","300000","400000", +"set_zipped_3","set","1000000000","2000000000","3000000000","4000000000","5000000000","6000000000", +"string","string","Hello World" +"zset","zset","a","1","b","2","c","3","aa","10","bb","20","cc","30","aaa","100","bbb","200","ccc","300","aaaa","1000","cccc","123456789","bbbb","5000000000", +"zset_zipped","zset","a","1","b","2","c","3", +} +} + +set server_path [tmpdir "server.rdb-startup-test"] + +start_server [list overrides [list "dir" $server_path]] { + test {Server started empty with non-existing RDB file} { + r debug digest + } {0000000000000000000000000000000000000000} + # Save an RDB file, needed for the next test. + r save +} + +start_server [list overrides [list "dir" $server_path]] { + test {Server started empty with empty RDB file} { + r debug digest + } {0000000000000000000000000000000000000000} +} + +# Helper function to start a server and kill it, just to check the error +# logged. +set defaults {} +proc start_server_and_kill_it {overrides code} { + upvar defaults defaults srv srv server_path server_path + set config [concat $defaults $overrides] + set srv [start_server [list overrides $config]] + uplevel 1 $code + kill_server $srv +} + +# Make the RDB file unreadable +file attributes [file join $server_path dump.rdb] -permissions 0222 + +# Detect root account (it is able to read the file even with 002 perm) +set isroot 0 +catch { + open [file join $server_path dump.rdb] + set isroot 1 +} + +# Now make sure the server aborted with an error +if {!$isroot} { + start_server_and_kill_it [list "dir" $server_path] { + test {Server should not start if RDB file can't be open} { + wait_for_condition 50 100 { + [string match {*Fatal error loading*} \ + [exec tail -n1 < [dict get $srv stdout]]] + } else { + fail "Server started even if RDB was unreadable!" + } + } + } +} + +# Fix permissions of the RDB file. +file attributes [file join $server_path dump.rdb] -permissions 0666 + +# Corrupt its CRC64 checksum. +set filesize [file size [file join $server_path dump.rdb]] +set fd [open [file join $server_path dump.rdb] r+] +fconfigure $fd -translation binary +seek $fd -8 end +puts -nonewline $fd "foobar00"; # Corrupt the checksum +close $fd + +# Now make sure the server aborted with an error +start_server_and_kill_it [list "dir" $server_path] { + test {Server should not start if RDB is corrupted} { + wait_for_condition 50 100 { + [string match {*RDB checksum*} \ + [exec tail -n1 < [dict get $srv stdout]]] + } else { + fail "Server started even if RDB was corrupted!" + } + } +} diff --git a/pikatests/tests/integration/redis-cli.tcl b/pikatests/tests/integration/redis-cli.tcl new file mode 100644 index 0000000000..40e4222e3e --- /dev/null +++ b/pikatests/tests/integration/redis-cli.tcl @@ -0,0 +1,208 @@ +start_server {tags {"cli"}} { + proc open_cli {} { + set ::env(TERM) dumb + set fd [open [format "|src/redis-cli -p %d -n 9" [srv port]] "r+"] + fconfigure $fd -buffering none + fconfigure $fd -blocking false + fconfigure $fd -translation binary + assert_equal "redis> " [read_cli $fd] + set _ $fd + } + + proc close_cli {fd} { + close $fd + } + + proc read_cli {fd} { + set buf [read $fd] + while {[string length $buf] == 0} { + # wait some time and try again + after 10 + set buf [read $fd] + } + set _ $buf + } + + proc write_cli {fd buf} { + puts $fd $buf + flush $fd + } + + # Helpers to run tests in interactive mode + proc run_command {fd cmd} { + write_cli $fd $cmd + set lines [split [read_cli $fd] "\n"] + assert_equal "redis> " [lindex $lines end] + join [lrange $lines 0 end-1] "\n" + } + + proc test_interactive_cli {name code} { + set ::env(FAKETTY) 1 + set fd [open_cli] + test "Interactive CLI: $name" $code + close_cli $fd + unset ::env(FAKETTY) + } + + # Helpers to run tests where stdout is not a tty + proc write_tmpfile {contents} { + set tmp [tmpfile "cli"] + set tmpfd [open $tmp "w"] + puts -nonewline $tmpfd $contents + close $tmpfd + set _ $tmp + } + + proc _run_cli {opts args} { + set cmd [format "src/redis-cli -p %d -n 9 $args" [srv port]] + foreach {key value} $opts { + if {$key eq "pipe"} { + set cmd "sh -c \"$value | $cmd\"" + } + if {$key eq "path"} { + set cmd "$cmd < $value" + } + } + + set fd [open "|$cmd" "r"] + fconfigure $fd -buffering none + fconfigure $fd -translation binary + set resp [read $fd 1048576] + close $fd + set _ $resp + } + + proc run_cli {args} { + _run_cli {} {*}$args + } + + proc run_cli_with_input_pipe {cmd args} { + _run_cli [list pipe $cmd] {*}$args + } + + proc run_cli_with_input_file {path args} { + _run_cli [list path $path] {*}$args + } + + proc test_nontty_cli {name code} { + test "Non-interactive non-TTY CLI: $name" $code + } + + # Helpers to run tests where stdout is a tty (fake it) + proc test_tty_cli {name code} { + set ::env(FAKETTY) 1 + test "Non-interactive TTY CLI: $name" $code + unset ::env(FAKETTY) + } + + test_interactive_cli "INFO response should be printed raw" { + set lines [split [run_command $fd info] "\n"] + foreach line $lines { + assert [regexp {^[a-z0-9_]+:[a-z0-9_]+} $line] + } + } + + test_interactive_cli "Status reply" { + assert_equal "OK" [run_command $fd "set key foo"] + } + + test_interactive_cli "Integer reply" { + assert_equal "(integer) 1" [run_command $fd "incr counter"] + } + + test_interactive_cli "Bulk reply" { + r set key foo + assert_equal "\"foo\"" [run_command $fd "get key"] + } + + test_interactive_cli "Multi-bulk reply" { + r rpush list foo + r rpush list bar + assert_equal "1. \"foo\"\n2. \"bar\"" [run_command $fd "lrange list 0 -1"] + } + + test_interactive_cli "Parsing quotes" { + assert_equal "OK" [run_command $fd "set key \"bar\""] + assert_equal "bar" [r get key] + assert_equal "OK" [run_command $fd "set key \" bar \""] + assert_equal " bar " [r get key] + assert_equal "OK" [run_command $fd "set key \"\\\"bar\\\"\""] + assert_equal "\"bar\"" [r get key] + assert_equal "OK" [run_command $fd "set key \"\tbar\t\""] + assert_equal "\tbar\t" [r get key] + + # invalid quotation + assert_equal "Invalid argument(s)" [run_command $fd "get \"\"key"] + assert_equal "Invalid argument(s)" [run_command $fd "get \"key\"x"] + + # quotes after the argument are weird, but should be allowed + assert_equal "OK" [run_command $fd "set key\"\" bar"] + assert_equal "bar" [r get key] + } + + test_tty_cli "Status reply" { + assert_equal "OK\n" [run_cli set key bar] + assert_equal "bar" [r get key] + } + + test_tty_cli "Integer reply" { + r del counter + assert_equal "(integer) 1\n" [run_cli incr counter] + } + + test_tty_cli "Bulk reply" { + r set key "tab\tnewline\n" + assert_equal "\"tab\\tnewline\\n\"\n" [run_cli get key] + } + + test_tty_cli "Multi-bulk reply" { + r del list + r rpush list foo + r rpush list bar + assert_equal "1. \"foo\"\n2. \"bar\"\n" [run_cli lrange list 0 -1] + } + + test_tty_cli "Read last argument from pipe" { + assert_equal "OK\n" [run_cli_with_input_pipe "echo foo" set key] + assert_equal "foo\n" [r get key] + } + + test_tty_cli "Read last argument from file" { + set tmpfile [write_tmpfile "from file"] + assert_equal "OK\n" [run_cli_with_input_file $tmpfile set key] + assert_equal "from file" [r get key] + } + + test_nontty_cli "Status reply" { + assert_equal "OK" [run_cli set key bar] + assert_equal "bar" [r get key] + } + + test_nontty_cli "Integer reply" { + r del counter + assert_equal "1" [run_cli incr counter] + } + + test_nontty_cli "Bulk reply" { + r set key "tab\tnewline\n" + assert_equal "tab\tnewline\n" [run_cli get key] + } + + test_nontty_cli "Multi-bulk reply" { + r del list + r rpush list foo + r rpush list bar + assert_equal "foo\nbar" [run_cli lrange list 0 -1] + } + + test_nontty_cli "Read last argument from pipe" { + assert_equal "OK" [run_cli_with_input_pipe "echo foo" set key] + assert_equal "foo\n" [r get key] + } + + test_nontty_cli "Read last argument from file" { + set tmpfile [write_tmpfile "from file"] + assert_equal "OK" [run_cli_with_input_file $tmpfile set key] + assert_equal "from file" [r get key] + } +} diff --git a/pikatests/tests/integration/replication-2.tcl b/pikatests/tests/integration/replication-2.tcl new file mode 100644 index 0000000000..9446e5cd91 --- /dev/null +++ b/pikatests/tests/integration/replication-2.tcl @@ -0,0 +1,87 @@ +start_server {tags {"repl"}} { + start_server {} { + test {First server should have role slave after SLAVEOF} { + r -1 slaveof [srv 0 host] [srv 0 port] + after 1000 + s -1 role + } {slave} + + test {If min-slaves-to-write is honored, write is accepted} { + r config set min-slaves-to-write 1 + r config set min-slaves-max-lag 10 + r set foo 12345 + wait_for_condition 50 100 { + [r -1 get foo] eq {12345} + } else { + fail "Write did not reached slave" + } + } + + test {No write if min-slaves-to-write is < attached slaves} { + r config set min-slaves-to-write 2 + r config set min-slaves-max-lag 10 + catch {r set foo 12345} err + set err + } {NOREPLICAS*} + + test {If min-slaves-to-write is honored, write is accepted (again)} { + r config set min-slaves-to-write 1 + r config set min-slaves-max-lag 10 + r set foo 12345 + wait_for_condition 50 100 { + [r -1 get foo] eq {12345} + } else { + fail "Write did not reached slave" + } + } + + test {No write if min-slaves-max-lag is > of the slave lag} { + r -1 deferred 1 + r config set min-slaves-to-write 1 + r config set min-slaves-max-lag 2 + r -1 debug sleep 6 + assert {[r set foo 12345] eq {OK}} + after 4000 + catch {r set foo 12345} err + assert {[r -1 read] eq {OK}} + r -1 deferred 0 + set err + } {NOREPLICAS*} + + test {min-slaves-to-write is ignored by slaves} { + r config set min-slaves-to-write 1 + r config set min-slaves-max-lag 10 + r -1 config set min-slaves-to-write 1 + r -1 config set min-slaves-max-lag 10 + r set foo aaabbb + wait_for_condition 50 100 { + [r -1 get foo] eq {aaabbb} + } else { + fail "Write did not reached slave" + } + } + + # Fix parameters for the next test to work + r config set min-slaves-to-write 0 + r -1 config set min-slaves-to-write 0 + r flushall + + test {MASTER and SLAVE dataset should be identical after complex ops} { + createComplexDataset r 10000 + after 500 + if {[r debug digest] ne [r -1 debug digest]} { + set csv1 [csvdump r] + set csv2 [csvdump {r -1}] + set fd [open /tmp/repldump1.txt w] + puts -nonewline $fd $csv1 + close $fd + set fd [open /tmp/repldump2.txt w] + puts -nonewline $fd $csv2 + close $fd + puts "Master - Slave inconsistency" + puts "Run diff -u against /tmp/repldump*.txt for more info" + } + assert_equal [r debug digest] [r -1 debug digest] + } + } +} diff --git a/pikatests/tests/integration/replication-3.tcl b/pikatests/tests/integration/replication-3.tcl new file mode 100644 index 0000000000..0fcbad45b0 --- /dev/null +++ b/pikatests/tests/integration/replication-3.tcl @@ -0,0 +1,101 @@ +start_server {tags {"repl"}} { + start_server {} { + test {First server should have role slave after SLAVEOF} { + r -1 slaveof [srv 0 host] [srv 0 port] + wait_for_condition 50 100 { + [s -1 master_link_status] eq {up} + } else { + fail "Replication not started." + } + } + + if {$::accurate} {set numops 50000} else {set numops 5000} + + test {MASTER and SLAVE consistency with expire} { + createComplexDataset r $numops useexpire + after 4000 ;# Make sure everything expired before taking the digest + r keys * ;# Force DEL syntesizing to slave + after 1000 ;# Wait another second. Now everything should be fine. + if {[r debug digest] ne [r -1 debug digest]} { + set csv1 [csvdump r] + set csv2 [csvdump {r -1}] + set fd [open /tmp/repldump1.txt w] + puts -nonewline $fd $csv1 + close $fd + set fd [open /tmp/repldump2.txt w] + puts -nonewline $fd $csv2 + close $fd + puts "Master - Slave inconsistency" + puts "Run diff -u against /tmp/repldump*.txt for more info" + } + assert_equal [r debug digest] [r -1 debug digest] + } + } +} + +start_server {tags {"repl"}} { + start_server {} { + test {First server should have role slave after SLAVEOF} { + r -1 slaveof [srv 0 host] [srv 0 port] + wait_for_condition 50 100 { + [s -1 master_link_status] eq {up} + } else { + fail "Replication not started." + } + } + + set numops 20000 ;# Enough to trigger the Script Cache LRU eviction. + + # While we are at it, enable AOF to test it will be consistent as well + # after the test. + r config set appendonly yes + + test {MASTER and SLAVE consistency with EVALSHA replication} { + array set oldsha {} + for {set j 0} {$j < $numops} {incr j} { + set key "key:$j" + # Make sure to create scripts that have different SHA1s + set script "return redis.call('incr','$key')" + set sha1 [r eval "return redis.sha1hex(\"$script\")" 0] + set oldsha($j) $sha1 + r eval $script 0 + set res [r evalsha $sha1 0] + assert {$res == 2} + # Additionally call one of the old scripts as well, at random. + set res [r evalsha $oldsha([randomInt $j]) 0] + assert {$res > 2} + + # Trigger an AOF rewrite while we are half-way, this also + # forces the flush of the script cache, and we will cover + # more code as a result. + if {$j == $numops / 2} { + catch {r bgrewriteaof} + } + } + + wait_for_condition 50 100 { + [r dbsize] == $numops && + [r -1 dbsize] == $numops && + [r debug digest] eq [r -1 debug digest] + } else { + set csv1 [csvdump r] + set csv2 [csvdump {r -1}] + set fd [open /tmp/repldump1.txt w] + puts -nonewline $fd $csv1 + close $fd + set fd [open /tmp/repldump2.txt w] + puts -nonewline $fd $csv2 + close $fd + puts "Master - Slave inconsistency" + puts "Run diff -u against /tmp/repldump*.txt for more info" + + } + + set old_digest [r debug digest] + r config set appendonly no + r debug loadaof + set new_digest [r debug digest] + assert {$old_digest eq $new_digest} + } + } +} diff --git a/pikatests/tests/integration/replication-4.tcl b/pikatests/tests/integration/replication-4.tcl new file mode 100644 index 0000000000..6db9ffe2bc --- /dev/null +++ b/pikatests/tests/integration/replication-4.tcl @@ -0,0 +1,136 @@ +proc start_bg_complex_data {host port db ops} { + set tclsh [info nameofexecutable] + exec $tclsh tests/helpers/bg_complex_data.tcl $host $port $db $ops & +} + +proc stop_bg_complex_data {handle} { + catch {exec /bin/kill -9 $handle} +} + +start_server {tags {"repl"}} { + start_server {} { + + set master [srv -1 client] + set master_host [srv -1 host] + set master_port [srv -1 port] + set slave [srv 0 client] + + set load_handle0 [start_bg_complex_data $master_host $master_port 9 100000] + set load_handle1 [start_bg_complex_data $master_host $master_port 11 100000] + set load_handle2 [start_bg_complex_data $master_host $master_port 12 100000] + + test {First server should have role slave after SLAVEOF} { + $slave slaveof $master_host $master_port + after 1000 + s 0 role + } {slave} + + test {Test replication with parallel clients writing in differnet DBs} { + after 5000 + stop_bg_complex_data $load_handle0 + stop_bg_complex_data $load_handle1 + stop_bg_complex_data $load_handle2 + set retry 10 + while {$retry && ([$master debug digest] ne [$slave debug digest])}\ + { + after 1000 + incr retry -1 + } + assert {[$master dbsize] > 0} + + if {[$master debug digest] ne [$slave debug digest]} { + set csv1 [csvdump r] + set csv2 [csvdump {r -1}] + set fd [open /tmp/repldump1.txt w] + puts -nonewline $fd $csv1 + close $fd + set fd [open /tmp/repldump2.txt w] + puts -nonewline $fd $csv2 + close $fd + puts "Master - Slave inconsistency" + puts "Run diff -u against /tmp/repldump*.txt for more info" + } + assert_equal [r debug digest] [r -1 debug digest] + } + } +} + +start_server {tags {"repl"}} { + start_server {} { + set master [srv -1 client] + set master_host [srv -1 host] + set master_port [srv -1 port] + set slave [srv 0 client] + + test {First server should have role slave after SLAVEOF} { + $slave slaveof $master_host $master_port + wait_for_condition 50 100 { + [s 0 master_link_status] eq {up} + } else { + fail "Replication not started." + } + } + + test {With min-slaves-to-write (1,3): master should be writable} { + $master config set min-slaves-max-lag 3 + $master config set min-slaves-to-write 1 + $master set foo bar + } {OK} + + test {With min-slaves-to-write (2,3): master should not be writable} { + $master config set min-slaves-max-lag 3 + $master config set min-slaves-to-write 2 + catch {$master set foo bar} e + set e + } {NOREPLICAS*} + + test {With min-slaves-to-write: master not writable with lagged slave} { + $master config set min-slaves-max-lag 2 + $master config set min-slaves-to-write 1 + assert {[$master set foo bar] eq {OK}} + $slave deferred 1 + $slave debug sleep 6 + after 4000 + catch {$master set foo bar} e + set e + } {NOREPLICAS*} + } +} + +start_server {tags {"repl"}} { + start_server {} { + set master [srv -1 client] + set master_host [srv -1 host] + set master_port [srv -1 port] + set slave [srv 0 client] + + test {First server should have role slave after SLAVEOF} { + $slave slaveof $master_host $master_port + wait_for_condition 50 100 { + [s 0 role] eq {slave} + } else { + fail "Replication not started." + } + } + + test {Replication: commands with many arguments (issue #1221)} { + # We now issue large MSET commands, that may trigger a specific + # class of bugs, see issue #1221. + for {set j 0} {$j < 100} {incr j} { + set cmd [list mset] + for {set x 0} {$x < 1000} {incr x} { + lappend cmd [randomKey] [randomValue] + } + $master {*}$cmd + } + + set retry 10 + while {$retry && ([$master debug digest] ne [$slave debug digest])}\ + { + after 1000 + incr retry -1 + } + assert {[$master dbsize] > 0} + } + } +} diff --git a/pikatests/tests/integration/replication-psync.tcl b/pikatests/tests/integration/replication-psync.tcl new file mode 100644 index 0000000000..f131dafe31 --- /dev/null +++ b/pikatests/tests/integration/replication-psync.tcl @@ -0,0 +1,115 @@ +proc start_bg_complex_data {host port db ops} { + set tclsh [info nameofexecutable] + exec $tclsh tests/helpers/bg_complex_data.tcl $host $port $db $ops & +} + +proc stop_bg_complex_data {handle} { + catch {exec /bin/kill -9 $handle} +} + +# Creates a master-slave pair and breaks the link continuously to force +# partial resyncs attempts, all this while flooding the master with +# write queries. +# +# You can specifiy backlog size, ttl, delay before reconnection, test duration +# in seconds, and an additional condition to verify at the end. +proc test_psync {descr duration backlog_size backlog_ttl delay cond} { + start_server {tags {"repl"}} { + start_server {} { + + set master [srv -1 client] + set master_host [srv -1 host] + set master_port [srv -1 port] + set slave [srv 0 client] + + $master config set repl-backlog-size $backlog_size + $master config set repl-backlog-ttl $backlog_ttl + + set load_handle0 [start_bg_complex_data $master_host $master_port 9 100000] + set load_handle1 [start_bg_complex_data $master_host $master_port 11 100000] + set load_handle2 [start_bg_complex_data $master_host $master_port 12 100000] + + test {Slave should be able to synchronize with the master} { + $slave slaveof $master_host $master_port + wait_for_condition 50 100 { + [lindex [r role] 0] eq {slave} && + [lindex [r role] 3] eq {connected} + } else { + fail "Replication not started." + } + } + + # Check that the background clients are actually writing. + test {Detect write load to master} { + wait_for_condition 50 100 { + [$master dbsize] > 100 + } else { + fail "Can't detect write load from background clients." + } + } + + test "Test replication partial resync: $descr" { + # Now while the clients are writing data, break the maste-slave + # link multiple times. + for {set j 0} {$j < $duration*10} {incr j} { + after 100 + # catch {puts "MASTER [$master dbsize] keys, SLAVE [$slave dbsize] keys"} + + if {($j % 20) == 0} { + catch { + if {$delay} { + $slave multi + $slave client kill $master_host:$master_port + $slave debug sleep $delay + $slave exec + } else { + $slave client kill $master_host:$master_port + } + } + } + } + stop_bg_complex_data $load_handle0 + stop_bg_complex_data $load_handle1 + stop_bg_complex_data $load_handle2 + set retry 10 + while {$retry && ([$master debug digest] ne [$slave debug digest])}\ + { + after 1000 + incr retry -1 + } + assert {[$master dbsize] > 0} + + if {[$master debug digest] ne [$slave debug digest]} { + set csv1 [csvdump r] + set csv2 [csvdump {r -1}] + set fd [open /tmp/repldump1.txt w] + puts -nonewline $fd $csv1 + close $fd + set fd [open /tmp/repldump2.txt w] + puts -nonewline $fd $csv2 + close $fd + puts "Master - Slave inconsistency" + puts "Run diff -u against /tmp/repldump*.txt for more info" + } + assert_equal [r debug digest] [r -1 debug digest] + eval $cond + } + } + } +} + +test_psync {ok psync} 6 1000000 3600 0 { + assert {[s -1 sync_partial_ok] > 0} +} + +test_psync {no backlog} 6 100 3600 0.5 { + assert {[s -1 sync_partial_err] > 0} +} + +test_psync {ok after delay} 3 100000000 3600 3 { + assert {[s -1 sync_partial_ok] > 0} +} + +test_psync {backlog expired} 3 100000000 1 3 { + assert {[s -1 sync_partial_err] > 0} +} diff --git a/pikatests/tests/integration/replication.tcl b/pikatests/tests/integration/replication.tcl new file mode 100644 index 0000000000..bb907eba8e --- /dev/null +++ b/pikatests/tests/integration/replication.tcl @@ -0,0 +1,215 @@ +start_server {tags {"repl"}} { + set A [srv 0 client] + set A_host [srv 0 host] + set A_port [srv 0 port] + start_server {} { + set B [srv 0 client] + set B_host [srv 0 host] + set B_port [srv 0 port] + + test {Set instance A as slave of B} { + $A slaveof $B_host $B_port + wait_for_condition 50 100 { + [lindex [$A role] 0] eq {slave} && + [string match {*master_link_status:up*} [$A info replication]] + } else { + fail "Can't turn the instance into a slave" + } + } + + test {BRPOPLPUSH replication, when blocking against empty list} { + set rd [redis_deferring_client] + $rd brpoplpush a b 5 + r lpush a foo + wait_for_condition 50 100 { + [$A debug digest] eq [$B debug digest] + } else { + fail "Master and slave have different digest: [$A debug digest] VS [$B debug digest]" + } + } + + test {BRPOPLPUSH replication, list exists} { + set rd [redis_deferring_client] + r lpush c 1 + r lpush c 2 + r lpush c 3 + $rd brpoplpush c d 5 + after 1000 + assert_equal [$A debug digest] [$B debug digest] + } + + test {BLPOP followed by role change, issue #2473} { + set rd [redis_deferring_client] + $rd blpop foo 0 ; # Block while B is a master + + # Turn B into master of A + $A slaveof no one + $B slaveof $A_host $A_port + wait_for_condition 50 100 { + [lindex [$B role] 0] eq {slave} && + [string match {*master_link_status:up*} [$B info replication]] + } else { + fail "Can't turn the instance into a slave" + } + + # Push elements into the "foo" list of the new slave. + # If the client is still attached to the instance, we'll get + # a desync between the two instances. + $A rpush foo a b c + after 100 + + wait_for_condition 50 100 { + [$A debug digest] eq [$B debug digest] && + [$A lrange foo 0 -1] eq {a b c} && + [$B lrange foo 0 -1] eq {a b c} + } else { + fail "Master and slave have different digest: [$A debug digest] VS [$B debug digest]" + } + } + } +} + +start_server {tags {"repl"}} { + r set mykey foo + + start_server {} { + test {Second server should have role master at first} { + s role + } {master} + + test {SLAVEOF should start with link status "down"} { + r slaveof [srv -1 host] [srv -1 port] + s master_link_status + } {down} + + test {The role should immediately be changed to "slave"} { + s role + } {slave} + + wait_for_sync r + test {Sync should have transferred keys from master} { + r get mykey + } {foo} + + test {The link status should be up} { + s master_link_status + } {up} + + test {SET on the master should immediately propagate} { + r -1 set mykey bar + + wait_for_condition 500 100 { + [r 0 get mykey] eq {bar} + } else { + fail "SET on master did not propagated on slave" + } + } + + test {FLUSHALL should replicate} { + r -1 flushall + if {$::valgrind} {after 2000} + list [r -1 dbsize] [r 0 dbsize] + } {0 0} + + test {ROLE in master reports master with a slave} { + set res [r -1 role] + lassign $res role offset slaves + assert {$role eq {master}} + assert {$offset > 0} + assert {[llength $slaves] == 1} + lassign [lindex $slaves 0] master_host master_port slave_offset + assert {$slave_offset <= $offset} + } + + test {ROLE in slave reports slave in connected state} { + set res [r role] + lassign $res role master_host master_port slave_state slave_offset + assert {$role eq {slave}} + assert {$slave_state eq {connected}} + } + } +} + +foreach dl {no yes} { + start_server {tags {"repl"}} { + set master [srv 0 client] + $master config set repl-diskless-sync $dl + set master_host [srv 0 host] + set master_port [srv 0 port] + set slaves {} + set load_handle0 [start_write_load $master_host $master_port 3] + set load_handle1 [start_write_load $master_host $master_port 5] + set load_handle2 [start_write_load $master_host $master_port 20] + set load_handle3 [start_write_load $master_host $master_port 8] + set load_handle4 [start_write_load $master_host $master_port 4] + start_server {} { + lappend slaves [srv 0 client] + start_server {} { + lappend slaves [srv 0 client] + start_server {} { + lappend slaves [srv 0 client] + test "Connect multiple slaves at the same time (issue #141), diskless=$dl" { + # Send SLAVEOF commands to slaves + [lindex $slaves 0] slaveof $master_host $master_port + [lindex $slaves 1] slaveof $master_host $master_port + [lindex $slaves 2] slaveof $master_host $master_port + + # Wait for all the three slaves to reach the "online" + # state from the POV of the master. + set retry 500 + while {$retry} { + set info [r -3 info] + if {[string match {*slave0:*state=online*slave1:*state=online*slave2:*state=online*} $info]} { + break + } else { + incr retry -1 + after 100 + } + } + if {$retry == 0} { + error "assertion:Slaves not correctly synchronized" + } + + # Wait that slaves acknowledge they are online so + # we are sure that DBSIZE and DEBUG DIGEST will not + # fail because of timing issues. + wait_for_condition 500 100 { + [lindex [[lindex $slaves 0] role] 3] eq {connected} && + [lindex [[lindex $slaves 1] role] 3] eq {connected} && + [lindex [[lindex $slaves 2] role] 3] eq {connected} + } else { + fail "Slaves still not connected after some time" + } + + # Stop the write load + stop_write_load $load_handle0 + stop_write_load $load_handle1 + stop_write_load $load_handle2 + stop_write_load $load_handle3 + stop_write_load $load_handle4 + + # Make sure that slaves and master have same + # number of keys + wait_for_condition 500 100 { + [$master dbsize] == [[lindex $slaves 0] dbsize] && + [$master dbsize] == [[lindex $slaves 1] dbsize] && + [$master dbsize] == [[lindex $slaves 2] dbsize] + } else { + fail "Different number of keys between masted and slave after too long time." + } + + # Check digests + set digest [$master debug digest] + set digest0 [[lindex $slaves 0] debug digest] + set digest1 [[lindex $slaves 1] debug digest] + set digest2 [[lindex $slaves 2] debug digest] + assert {$digest ne 0000000000000000000000000000000000000000} + assert {$digest eq $digest0} + assert {$digest eq $digest1} + assert {$digest eq $digest2} + } + } + } + } + } +} diff --git a/pikatests/tests/sentinel/run.tcl b/pikatests/tests/sentinel/run.tcl new file mode 100644 index 0000000000..f330299599 --- /dev/null +++ b/pikatests/tests/sentinel/run.tcl @@ -0,0 +1,22 @@ +# Sentinel test suite. Copyright (C) 2014 Salvatore Sanfilippo antirez@gmail.com +# This software is released under the BSD License. See the COPYING file for +# more information. + +cd tests/sentinel +source ../instances.tcl + +set ::instances_count 5 ; # How many instances we use at max. + +proc main {} { + parse_options + spawn_instance sentinel $::sentinel_base_port $::instances_count + spawn_instance redis $::redis_base_port $::instances_count + run_tests + cleanup +} + +if {[catch main e]} { + puts $::errorInfo + cleanup + exit 1 +} diff --git a/pikatests/tests/sentinel/tests/00-base.tcl b/pikatests/tests/sentinel/tests/00-base.tcl new file mode 100644 index 0000000000..a79d0c371c --- /dev/null +++ b/pikatests/tests/sentinel/tests/00-base.tcl @@ -0,0 +1,126 @@ +# Check the basic monitoring and failover capabilities. + +source "../tests/includes/init-tests.tcl" + +if {$::simulate_error} { + test "This test will fail" { + fail "Simulated error" + } +} + +test "Basic failover works if the master is down" { + set old_port [RI $master_id tcp_port] + set addr [S 0 SENTINEL GET-MASTER-ADDR-BY-NAME mymaster] + assert {[lindex $addr 1] == $old_port} + kill_instance redis $master_id + foreach_sentinel_id id { + wait_for_condition 1000 50 { + [lindex [S $id SENTINEL GET-MASTER-ADDR-BY-NAME mymaster] 1] != $old_port + } else { + fail "At least one Sentinel did not received failover info" + } + } + restart_instance redis $master_id + set addr [S 0 SENTINEL GET-MASTER-ADDR-BY-NAME mymaster] + set master_id [get_instance_id_by_port redis [lindex $addr 1]] +} + +test "New master [join $addr {:}] role matches" { + assert {[RI $master_id role] eq {master}} +} + +test "All the other slaves now point to the new master" { + foreach_redis_id id { + if {$id != $master_id && $id != 0} { + wait_for_condition 1000 50 { + [RI $id master_port] == [lindex $addr 1] + } else { + fail "Redis ID $id not configured to replicate with new master" + } + } + } +} + +test "The old master eventually gets reconfigured as a slave" { + wait_for_condition 1000 50 { + [RI 0 master_port] == [lindex $addr 1] + } else { + fail "Old master not reconfigured as slave of new master" + } +} + +test "ODOWN is not possible without N (quorum) Sentinels reports" { + foreach_sentinel_id id { + S $id SENTINEL SET mymaster quorum [expr $sentinels+1] + } + set old_port [RI $master_id tcp_port] + set addr [S 0 SENTINEL GET-MASTER-ADDR-BY-NAME mymaster] + assert {[lindex $addr 1] == $old_port} + kill_instance redis $master_id + + # Make sure failover did not happened. + set addr [S 0 SENTINEL GET-MASTER-ADDR-BY-NAME mymaster] + assert {[lindex $addr 1] == $old_port} + restart_instance redis $master_id +} + +test "Failover is not possible without majority agreement" { + foreach_sentinel_id id { + S $id SENTINEL SET mymaster quorum $quorum + } + + # Crash majority of sentinels + for {set id 0} {$id < $quorum} {incr id} { + kill_instance sentinel $id + } + + # Kill the current master + kill_instance redis $master_id + + # Make sure failover did not happened. + set addr [S $quorum SENTINEL GET-MASTER-ADDR-BY-NAME mymaster] + assert {[lindex $addr 1] == $old_port} + restart_instance redis $master_id + + # Cleanup: restart Sentinels to monitor the master. + for {set id 0} {$id < $quorum} {incr id} { + restart_instance sentinel $id + } +} + +test "Failover works if we configure for absolute agreement" { + foreach_sentinel_id id { + S $id SENTINEL SET mymaster quorum $sentinels + } + + # Wait for Sentinels to monitor the master again + foreach_sentinel_id id { + wait_for_condition 1000 50 { + [dict get [S $id SENTINEL MASTER mymaster] info-refresh] < 100000 + } else { + fail "At least one Sentinel is not monitoring the master" + } + } + + kill_instance redis $master_id + + foreach_sentinel_id id { + wait_for_condition 1000 50 { + [lindex [S $id SENTINEL GET-MASTER-ADDR-BY-NAME mymaster] 1] != $old_port + } else { + fail "At least one Sentinel did not received failover info" + } + } + restart_instance redis $master_id + set addr [S 0 SENTINEL GET-MASTER-ADDR-BY-NAME mymaster] + set master_id [get_instance_id_by_port redis [lindex $addr 1]] + + # Set the min ODOWN agreement back to strict majority. + foreach_sentinel_id id { + S $id SENTINEL SET mymaster quorum $quorum + } +} + +test "New master [join $addr {:}] role matches" { + assert {[RI $master_id role] eq {master}} +} diff --git a/pikatests/tests/sentinel/tests/01-conf-update.tcl b/pikatests/tests/sentinel/tests/01-conf-update.tcl new file mode 100644 index 0000000000..4998104d2f --- /dev/null +++ b/pikatests/tests/sentinel/tests/01-conf-update.tcl @@ -0,0 +1,39 @@ +# Test Sentinel configuration consistency after partitions heal. + +source "../tests/includes/init-tests.tcl" + +test "We can failover with Sentinel 1 crashed" { + set old_port [RI $master_id tcp_port] + set addr [S 0 SENTINEL GET-MASTER-ADDR-BY-NAME mymaster] + assert {[lindex $addr 1] == $old_port} + + # Crash Sentinel 1 + kill_instance sentinel 1 + + kill_instance redis $master_id + foreach_sentinel_id id { + if {$id != 1} { + wait_for_condition 1000 50 { + [lindex [S $id SENTINEL GET-MASTER-ADDR-BY-NAME mymaster] 1] != $old_port + } else { + fail "Sentinel $id did not received failover info" + } + } + } + restart_instance redis $master_id + set addr [S 0 SENTINEL GET-MASTER-ADDR-BY-NAME mymaster] + set master_id [get_instance_id_by_port redis [lindex $addr 1]] +} + +test "After Sentinel 1 is restarted, its config gets updated" { + restart_instance sentinel 1 + wait_for_condition 1000 50 { + [lindex [S 1 SENTINEL GET-MASTER-ADDR-BY-NAME mymaster] 1] != $old_port + } else { + fail "Restarted Sentinel did not received failover info" + } +} + +test "New master [join $addr {:}] role matches" { + assert {[RI $master_id role] eq {master}} +} diff --git a/pikatests/tests/sentinel/tests/02-slaves-reconf.tcl b/pikatests/tests/sentinel/tests/02-slaves-reconf.tcl new file mode 100644 index 0000000000..fa15d2efde --- /dev/null +++ b/pikatests/tests/sentinel/tests/02-slaves-reconf.tcl @@ -0,0 +1,84 @@ +# Check that slaves are reconfigured at a latter time if they are partitioned. +# +# Here we should test: +# 1) That slaves point to the new master after failover. +# 2) That partitioned slaves point to new master when they are partitioned +# away during failover and return at a latter time. + +source "../tests/includes/init-tests.tcl" + +proc 02_test_slaves_replication {} { + uplevel 1 { + test "Check that slaves replicate from current master" { + set master_port [RI $master_id tcp_port] + foreach_redis_id id { + if {$id == $master_id} continue + if {[instance_is_killed redis $id]} continue + wait_for_condition 1000 50 { + ([RI $id master_port] == $master_port) && + ([RI $id master_link_status] eq {up}) + } else { + fail "Redis slave $id is replicating from wrong master" + } + } + } + } +} + +proc 02_crash_and_failover {} { + uplevel 1 { + test "Crash the master and force a failover" { + set old_port [RI $master_id tcp_port] + set addr [S 0 SENTINEL GET-MASTER-ADDR-BY-NAME mymaster] + assert {[lindex $addr 1] == $old_port} + kill_instance redis $master_id + foreach_sentinel_id id { + wait_for_condition 1000 50 { + [lindex [S $id SENTINEL GET-MASTER-ADDR-BY-NAME mymaster] 1] != $old_port + } else { + fail "At least one Sentinel did not received failover info" + } + } + restart_instance redis $master_id + set addr [S 0 SENTINEL GET-MASTER-ADDR-BY-NAME mymaster] + set master_id [get_instance_id_by_port redis [lindex $addr 1]] + } + } +} + +02_test_slaves_replication +02_crash_and_failover +02_test_slaves_replication + +test "Kill a slave instance" { + foreach_redis_id id { + if {$id == $master_id} continue + set killed_slave_id $id + kill_instance redis $id + break + } +} + +02_crash_and_failover +02_test_slaves_replication + +test "Wait for failover to end" { + set inprogress 1 + while {$inprogress} { + set inprogress 0 + foreach_sentinel_id id { + if {[dict exists [S $id SENTINEL MASTER mymaster] failover-state]} { + incr inprogress + } + } + if {$inprogress} {after 100} + } +} + +test "Restart killed slave and test replication of slaves again..." { + restart_instance redis $killed_slave_id +} + +# Now we check if the slave rejoining the partition is reconfigured even +# if the failover finished. +02_test_slaves_replication diff --git a/pikatests/tests/sentinel/tests/03-runtime-reconf.tcl b/pikatests/tests/sentinel/tests/03-runtime-reconf.tcl new file mode 100644 index 0000000000..426596c37e --- /dev/null +++ b/pikatests/tests/sentinel/tests/03-runtime-reconf.tcl @@ -0,0 +1 @@ +# Test runtime reconfiguration command SENTINEL SET. diff --git a/pikatests/tests/sentinel/tests/04-slave-selection.tcl b/pikatests/tests/sentinel/tests/04-slave-selection.tcl new file mode 100644 index 0000000000..3d2ca64845 --- /dev/null +++ b/pikatests/tests/sentinel/tests/04-slave-selection.tcl @@ -0,0 +1,5 @@ +# Test slave selection algorithm. +# +# This unit should test: +# 1) That when there are no suitable slaves no failover is performed. +# 2) That among the available slaves, the one with better offset is picked. diff --git a/pikatests/tests/sentinel/tests/05-manual.tcl b/pikatests/tests/sentinel/tests/05-manual.tcl new file mode 100644 index 0000000000..1a60d814b3 --- /dev/null +++ b/pikatests/tests/sentinel/tests/05-manual.tcl @@ -0,0 +1,44 @@ +# Test manual failover + +source "../tests/includes/init-tests.tcl" + +test "Manual failover works" { + set old_port [RI $master_id tcp_port] + set addr [S 0 SENTINEL GET-MASTER-ADDR-BY-NAME mymaster] + assert {[lindex $addr 1] == $old_port} + S 0 SENTINEL FAILOVER mymaster + foreach_sentinel_id id { + wait_for_condition 1000 50 { + [lindex [S $id SENTINEL GET-MASTER-ADDR-BY-NAME mymaster] 1] != $old_port + } else { + fail "At least one Sentinel did not received failover info" + } + } + set addr [S 0 SENTINEL GET-MASTER-ADDR-BY-NAME mymaster] + set master_id [get_instance_id_by_port redis [lindex $addr 1]] +} + +test "New master [join $addr {:}] role matches" { + assert {[RI $master_id role] eq {master}} +} + +test "All the other slaves now point to the new master" { + foreach_redis_id id { + if {$id != $master_id && $id != 0} { + wait_for_condition 1000 50 { + [RI $id master_port] == [lindex $addr 1] + } else { + fail "Redis ID $id not configured to replicate with new master" + } + } + } +} + +test "The old master eventually gets reconfigured as a slave" { + wait_for_condition 1000 50 { + [RI 0 master_port] == [lindex $addr 1] + } else { + fail "Old master not reconfigured as slave of new master" + } +} + diff --git a/pikatests/tests/sentinel/tests/includes/init-tests.tcl b/pikatests/tests/sentinel/tests/includes/init-tests.tcl new file mode 100644 index 0000000000..c8165dcfa9 --- /dev/null +++ b/pikatests/tests/sentinel/tests/includes/init-tests.tcl @@ -0,0 +1,72 @@ +# Initialization tests -- most units will start including this. + +test "(init) Restart killed instances" { + foreach type {redis sentinel} { + foreach_${type}_id id { + if {[get_instance_attrib $type $id pid] == -1} { + puts -nonewline "$type/$id " + flush stdout + restart_instance $type $id + } + } + } +} + +test "(init) Remove old master entry from sentinels" { + foreach_sentinel_id id { + catch {S $id SENTINEL REMOVE mymaster} + } +} + +set redis_slaves 4 +test "(init) Create a master-slaves cluster of [expr $redis_slaves+1] instances" { + create_redis_master_slave_cluster [expr {$redis_slaves+1}] +} +set master_id 0 + +test "(init) Sentinels can start monitoring a master" { + set sentinels [llength $::sentinel_instances] + set quorum [expr {$sentinels/2+1}] + foreach_sentinel_id id { + S $id SENTINEL MONITOR mymaster \ + [get_instance_attrib redis $master_id host] \ + [get_instance_attrib redis $master_id port] $quorum + } + foreach_sentinel_id id { + assert {[S $id sentinel master mymaster] ne {}} + S $id SENTINEL SET mymaster down-after-milliseconds 2000 + S $id SENTINEL SET mymaster failover-timeout 20000 + S $id SENTINEL SET mymaster parallel-syncs 10 + } +} + +test "(init) Sentinels can talk with the master" { + foreach_sentinel_id id { + wait_for_condition 1000 50 { + [catch {S $id SENTINEL GET-MASTER-ADDR-BY-NAME mymaster}] == 0 + } else { + fail "Sentinel $id can't talk with the master." + } + } +} + +test "(init) Sentinels are able to auto-discover other sentinels" { + set sentinels [llength $::sentinel_instances] + foreach_sentinel_id id { + wait_for_condition 1000 50 { + [dict get [S $id SENTINEL MASTER mymaster] num-other-sentinels] == ($sentinels-1) + } else { + fail "At least some sentinel can't detect some other sentinel" + } + } +} + +test "(init) Sentinels are able to auto-discover slaves" { + foreach_sentinel_id id { + wait_for_condition 1000 50 { + [dict get [S $id SENTINEL MASTER mymaster] num-slaves] == $redis_slaves + } else { + fail "At least some sentinel can't detect some slave" + } + } +} diff --git a/pikatests/tests/sentinel/tmp/.gitignore b/pikatests/tests/sentinel/tmp/.gitignore new file mode 100644 index 0000000000..f581f73e2d --- /dev/null +++ b/pikatests/tests/sentinel/tmp/.gitignore @@ -0,0 +1,2 @@ +redis_* +sentinel_* diff --git a/pikatests/tests/support/redis.tcl b/pikatests/tests/support/redis.tcl new file mode 100644 index 0000000000..7c78360812 --- /dev/null +++ b/pikatests/tests/support/redis.tcl @@ -0,0 +1,294 @@ +# Tcl clinet library - used by test-redis.tcl script for now +# Copyright (C) 2009 Salvatore Sanfilippo +# Released under the BSD license like Redis itself +# +# Example usage: +# +# set r [redis 127.0.0.1 6379] +# $r lpush mylist foo +# $r lpush mylist bar +# $r lrange mylist 0 -1 +# $r close +# +# Non blocking usage example: +# +# proc handlePong {r type reply} { +# puts "PONG $type '$reply'" +# if {$reply ne "PONG"} { +# $r ping [list handlePong] +# } +# } +# +# set r [redis] +# $r blocking 0 +# $r get fo [list handlePong] +# +# vwait forever + +package require Tcl 8.5 +package provide redis 0.1 + +namespace eval redis {} +set ::redis::id 0 +array set ::redis::fd {} +array set ::redis::addr {} +array set ::redis::blocking {} +array set ::redis::deferred {} +array set ::redis::reconnect {} +array set ::redis::callback {} +array set ::redis::state {} ;# State in non-blocking reply reading +array set ::redis::statestack {} ;# Stack of states, for nested mbulks + +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::addr($id) [list $server $port] + set ::redis::blocking($id) 1 + set ::redis::deferred($id) $defer + set ::redis::reconnect($id) 0 + ::redis::redis_reset_state $id + interp alias {} ::redis::redisHandle$id {} ::redis::__dispatch__ $id +} + +# This is a wrapper to the actual dispatching procedure that handles +# reconnection if needed. +proc ::redis::__dispatch__ {id method args} { + set errorcode [catch {::redis::__dispatch__raw__ $id $method $args} retval] + if {$errorcode && $::redis::reconnect($id) && $::redis::fd($id) eq {}} { + # Try again if the connection was lost. + # FIXME: we don't re-select the previously selected DB, nor we check + # if we are inside a transaction that needs to be re-issued from + # scratch. + set errorcode [catch {::redis::__dispatch__raw__ $id $method $args} retval] + } + return -code $errorcode $retval +} + +proc ::redis::__dispatch__raw__ {id method argv} { + set fd $::redis::fd($id) + + # Reconnect the link if needed. + if {$fd eq {}} { + lassign $::redis::addr($id) host port + set ::redis::fd($id) [socket $host $port] + fconfigure $::redis::fd($id) -translation binary + set fd $::redis::fd($id) + } + + set blocking $::redis::blocking($id) + set deferred $::redis::deferred($id) + if {$blocking == 0} { + if {[llength $argv] == 0} { + error "Please provide a callback in non-blocking mode" + } + set callback [lindex $argv end] + set argv [lrange $argv 0 end-1] + } + if {[info command ::redis::__method__$method] eq {}} { + set cmd "*[expr {[llength $argv]+1}]\r\n" + append cmd "$[string length $method]\r\n$method\r\n" + foreach a $argv { + append cmd "$[string length $a]\r\n$a\r\n" + } + ::redis::redis_write $fd $cmd + if {[catch {flush $fd}]} { + set ::redis::fd($id) {} + return -code error "I/O error reading reply" + } + + if {!$deferred} { + if {$blocking} { + ::redis::redis_read_reply $id $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] $argv + } +} + +proc ::redis::__method__blocking {id fd val} { + set ::redis::blocking($id) $val + fconfigure $fd -blocking $val +} + +proc ::redis::__method__reconnect {id fd val} { + set ::redis::reconnect($id) $val +} + +proc ::redis::__method__read {id fd} { + ::redis::redis_read_reply $id $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)} + catch {unset ::redis::addr($id)} + catch {unset ::redis::blocking($id)} + catch {unset ::redis::deferred($id)} + catch {unset ::redis::reconnect($id)} + catch {unset ::redis::state($id)} + catch {unset ::redis::statestack($id)} + catch {unset ::redis::callback($id)} + catch {interp alias {} ::redis::redisHandle$id {}} +} + +proc ::redis::__method__channel {id fd} { + return $fd +} + +proc ::redis::__method__deferred {id fd val} { + set ::redis::deferred($id) $val +} + +proc ::redis::redis_write {fd buf} { + puts -nonewline $fd $buf +} + +proc ::redis::redis_writenl {fd buf} { + redis_write $fd $buf + redis_write $fd "\r\n" + flush $fd +} + +proc ::redis::redis_readnl {fd len} { + set buf [read $fd $len] + read $fd 2 ; # discard CR LF + return $buf +} + +proc ::redis::redis_bulk_read {fd} { + set count [redis_read_line $fd] + if {$count == -1} return {} + set buf [redis_readnl $fd $count] + return $buf +} + +proc ::redis::redis_multi_bulk_read {id fd} { + set count [redis_read_line $fd] + if {$count == -1} return {} + set l {} + set err {} + for {set i 0} {$i < $count} {incr i} { + if {[catch { + lappend l [redis_read_reply $id $fd] + } e] && $err eq {}} { + set err $e + } + } + if {$err ne {}} {return -code error $err} + return $l +} + +proc ::redis::redis_read_line fd { + string trim [gets $fd] +} + +proc ::redis::redis_read_reply {id fd} { + set type [read $fd 1] + switch -exact -- $type { + : - + + {redis_read_line $fd} + - {return -code error [redis_read_line $fd]} + $ {redis_bulk_read $fd} + * {redis_multi_bulk_read $id $fd} + default { + if {$type eq {}} { + set ::redis::fd($id) {} + return -code error "I/O error reading reply" + } + return -code error "Bad protocol, '$type' as reply type byte" + } + } +} + +proc ::redis::redis_reset_state id { + set ::redis::state($id) [dict create buf {} mbulk -1 bulk -1 reply {}] + set ::redis::statestack($id) {} +} + +proc ::redis::redis_call_callback {id type reply} { + set cb [lindex $::redis::callback($id) 0] + set ::redis::callback($id) [lrange $::redis::callback($id) 1 end] + uplevel #0 $cb [list ::redis::redisHandle$id $type $reply] + ::redis::redis_reset_state $id +} + +# Read a reply in non-blocking mode. +proc ::redis::redis_readable {fd id} { + if {[eof $fd]} { + redis_call_callback $id eof {} + ::redis::__method__close $id $fd + return + } + if {[dict get $::redis::state($id) bulk] == -1} { + set line [gets $fd] + if {$line eq {}} return ;# No complete line available, return + switch -exact -- [string index $line 0] { + : - + + {redis_call_callback $id reply [string range $line 1 end-1]} + - {redis_call_callback $id err [string range $line 1 end-1]} + $ { + dict set ::redis::state($id) bulk \ + [expr [string range $line 1 end-1]+2] + if {[dict get $::redis::state($id) bulk] == 1} { + # We got a $-1, hack the state to play well with this. + dict set ::redis::state($id) bulk 2 + dict set ::redis::state($id) buf "\r\n" + ::redis::redis_readable $fd $id + } + } + * { + dict set ::redis::state($id) mbulk [string range $line 1 end-1] + # Handle *-1 + if {[dict get $::redis::state($id) mbulk] == -1} { + redis_call_callback $id reply {} + } + } + default { + redis_call_callback $id err \ + "Bad protocol, $type as reply type byte" + } + } + } else { + set totlen [dict get $::redis::state($id) bulk] + set buflen [string length [dict get $::redis::state($id) buf]] + set toread [expr {$totlen-$buflen}] + set data [read $fd $toread] + set nread [string length $data] + dict append ::redis::state($id) buf $data + # Check if we read a complete bulk reply + if {[string length [dict get $::redis::state($id) buf]] == + [dict get $::redis::state($id) bulk]} { + if {[dict get $::redis::state($id) mbulk] == -1} { + redis_call_callback $id reply \ + [string range [dict get $::redis::state($id) buf] 0 end-2] + } else { + dict with ::redis::state($id) { + lappend reply [string range $buf 0 end-2] + incr mbulk -1 + set bulk -1 + } + if {[dict get $::redis::state($id) mbulk] == 0} { + redis_call_callback $id reply \ + [dict get $::redis::state($id) reply] + } + } + } + } +} diff --git a/pikatests/tests/support/server.tcl b/pikatests/tests/support/server.tcl new file mode 100644 index 0000000000..5a1e05dd05 --- /dev/null +++ b/pikatests/tests/support/server.tcl @@ -0,0 +1,336 @@ +set ::global_overrides {} +set ::tags {} +set ::valgrind_errors {} + +proc start_server_error {config_file error} { + set err {} + append err "Cant' start the Redis server\n" + append err "CONFIGURATION:" + append err [exec cat $config_file] + append err "\nERROR:" + append err [string trim $error] + send_data_packet $::test_server_fd err $err +} + +proc check_valgrind_errors stderr { + set fd [open $stderr] + set buf [read $fd] + close $fd + + if {[regexp -- { at 0x} $buf] || + (![regexp -- {definitely lost: 0 bytes} $buf] && + ![regexp -- {no leaks are possible} $buf])} { + send_data_packet $::test_server_fd err "Valgrind error: $buf\n" + } +} + +proc kill_server config { + # nothing to kill when running against external server + if {$::external} return + + # nevermind if its already dead + if {![is_alive $config]} { return } + set pid [dict get $config pid] + + # check for leaks + if {![dict exists $config "skipleaks"]} { + catch { + if {[string match {*Darwin*} [exec uname -a]]} { + tags {"leaks"} { + test "Check for memory leaks (pid $pid)" { + set output {0 leaks} + catch {exec leaks $pid} output + if {[string match {*process does not exist*} $output] || + [string match {*cannot examine*} $output]} { + # In a few tests we kill the server process. + set output "0 leaks" + } + set output + } {*0 leaks*} + } + } + } + } + + # kill server and wait for the process to be totally exited + catch {exec kill $pid} + while {[is_alive $config]} { + incr wait 10 + + if {$wait >= 5000} { + puts "Forcing process $pid to exit..." + catch {exec kill -KILL $pid} + } elseif {$wait % 1000 == 0} { + puts "Waiting for process $pid to exit..." + } + after 10 + } + + # Check valgrind errors if needed + if {$::valgrind} { + check_valgrind_errors [dict get $config stderr] + } + + # Remove this pid from the set of active pids in the test server. + send_data_packet $::test_server_fd server-killed $pid +} + +proc is_alive config { + set pid [dict get $config pid] + if {[catch {exec ps -p $pid} err]} { + return 0 + } else { + return 1 + } +} + +proc ping_server {host port} { + set retval 0 + if {[catch { + set fd [socket $host $port] + fconfigure $fd -translation binary + puts $fd "PING\r\n" + flush $fd + set reply [gets $fd] + if {[string range $reply 0 0] eq {+} || + [string range $reply 0 0] eq {-}} { + set retval 1 + } + close $fd + } e]} { + if {$::verbose} { + puts -nonewline "." + } + } else { + if {$::verbose} { + puts -nonewline "ok" + } + } + return $retval +} + +# Return 1 if the server at the specified addr is reachable by PING, otherwise +# returns 0. Performs a try every 50 milliseconds for the specified number +# of retries. +proc server_is_up {host port retrynum} { + after 10 ;# Use a small delay to make likely a first-try success. + set retval 0 + while {[incr retrynum -1]} { + if {[catch {ping_server $host $port} ping]} { + set ping 0 + } + if {$ping} {return 1} + after 50 + } + return 0 +} + +# doesn't really belong here, but highly coupled to code in start_server +proc tags {tags code} { + set ::tags [concat $::tags $tags] + uplevel 1 $code + set ::tags [lrange $::tags 0 end-[llength $tags]] +} + +proc start_server {options {code undefined}} { + # If we are running against an external server, we just push the + # host/port pair in the stack the first time + if {$::external} { + if {[llength $::servers] == 0} { + set srv {} + dict set srv "host" $::host + dict set srv "port" $::port + set client [redis $::host $::port] + dict set srv "client" $client + $client select 9 + + # append the server to the stack + lappend ::servers $srv + } + uplevel 1 $code + return + } + + # setup defaults + set baseconfig "default.conf" + set overrides {} + set tags {} + + # parse options + foreach {option value} $options { + switch $option { + "config" { + set baseconfig $value } + "overrides" { + set overrides $value } + "tags" { + set tags $value + set ::tags [concat $::tags $value] } + default { + error "Unknown option $option" } + } + } + + set data [split [exec cat "tests/assets/$baseconfig"] "\n"] + set config {} + foreach line $data { + if {[string length $line] > 0 && [string index $line 0] ne "#"} { + set elements [split $line " "] + set directive [lrange $elements 0 0] + set arguments [lrange $elements 1 end] + dict set config $directive $arguments + } + } + + # use a different directory every time a server is started + dict set config dir [tmpdir server] + + # start every server on a different port + set ::port [find_available_port [expr {$::port+1}]] + dict set config port $::port + + # apply overrides from global space and arguments + foreach {directive arguments} [concat $::global_overrides $overrides] { + dict set config $directive $arguments + } + + # write new configuration to temporary file + set config_file [tmpfile redis.conf] + set fp [open $config_file w+] + foreach directive [dict keys $config] { + if {$directive == "port"} { + puts -nonewline $fp "$directive : " + puts $fp [dict get $config $directive] + } elseif {$directive == "requirepass"} { + puts $fp "$directive :" + } elseif {$directive == "dump_prefix"} { + puts $fp "$directive :" + } else { + puts -nonewline $fp "$directive " + puts $fp [dict get $config $directive] + } + } + close $fp + + set stdout [format "%s/%s" [dict get $config "dir"] "stdout"] + set stderr [format "%s/%s" [dict get $config "dir"] "stderr"] + + if {$::valgrind} { + set pid [exec valgrind --suppressions=src/valgrind.sup --show-reachable=no --show-possibly-lost=no --leak-check=full src/redis-server $config_file > $stdout 2> $stderr &] + } else { + set pid [exec src/redis-server -c $config_file > $stdout 2> $stderr &] + } + + puts "Starting ---- " + + # Tell the test server about this new instance. + send_data_packet $::test_server_fd server-spawned $pid + + # check that the server actually started + # ugly but tries to be as fast as possible... + if {$::valgrind} {set retrynum 1000} else {set retrynum 100} + + if {$::verbose} { + puts -nonewline "=== ($tags) Starting server ${::host}:${::port} " + } + + if {$code ne "undefined"} { + set serverisup [server_is_up $::host $::port $retrynum] + } else { + set serverisup 1 + } + + if {$::verbose} { + puts "" + } + + if {!$serverisup} { + set err {} + append err [exec cat $stdout] "\n" [exec cat $stderr] + start_server_error $config_file $err + return + } + + puts "Before Wait" + # Wait for actual startup + #while {![info exists _pid]} { + # regexp {PID:\s(\d+)} [exec cat $stdout] _ _pid + # after 100 + #} + puts "After Wait" + + # setup properties to be able to initialize a client object + set host $::host + set port $::port + if {[dict exists $config bind]} { set host [dict get $config bind] } + if {[dict exists $config port]} { set port [dict get $config port] } + + # setup config dict + dict set srv "config_file" $config_file + dict set srv "config" $config + dict set srv "pid" $pid + dict set srv "host" $host + dict set srv "port" $port + dict set srv "stdout" $stdout + dict set srv "stderr" $stderr + + # if a block of code is supplied, we wait for the server to become + # available, create a client object and kill the server afterwards + if {$code ne "undefined"} { + set line [exec head -n1 $stdout] + if {[string match {*already in use*} $line]} { + error_and_quit $config_file $line + } + + while 1 { + # check that the server actually started and is ready for connections + if {[exec grep "going to start" | wc -l < $stderr] > 0} { + break + } + puts "Fuck YYB" + after 10 + } + + # append the server to the stack + lappend ::servers $srv + + # connect client (after server dict is put on the stack) + reconnect + + # execute provided block + 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 + } + + # 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] + + set ::tags [lrange $::tags 0 end-[llength $tags]] + kill_server $srv + } else { + set ::tags [lrange $::tags 0 end-[llength $tags]] + set _ $srv + } +} diff --git a/pikatests/tests/support/test.tcl b/pikatests/tests/support/test.tcl new file mode 100644 index 0000000000..7d390cc47a --- /dev/null +++ b/pikatests/tests/support/test.tcl @@ -0,0 +1,130 @@ +set ::num_tests 0 +set ::num_passed 0 +set ::num_failed 0 +set ::tests_failed {} + +proc fail {msg} { + error "assertion:$msg" +} + +proc assert {condition} { + if {![uplevel 1 [list expr $condition]]} { + error "assertion:Expected condition '$condition' to be true ([uplevel 1 [list subst -nocommands $condition]])" + } +} + +proc assert_match {pattern value} { + if {![string match $pattern $value]} { + error "assertion:Expected '$value' to match '$pattern'" + } +} + +proc assert_equal {expected value} { + if {$expected ne $value} { + error "assertion:Expected '$value' to be equal to '$expected'" + } +} + +proc assert_error {pattern code} { + if {[catch {uplevel 1 $code} error]} { + assert_match $pattern $error + } else { + error "assertion:Expected an error but nothing was caught" + } +} + +proc assert_encoding {enc key} { + # Swapped out values don't have an encoding, so make sure that + # the value is swapped in before checking the encoding. + set dbg [r debug object $key] + while {[string match "* swapped at:*" $dbg]} { + r debug swapin $key + set dbg [r debug object $key] + } + assert_match "* encoding:$enc *" $dbg +} + +proc assert_type {type key} { + assert_equal $type [r type $key] +} + +# Wait for the specified condition to be true, with the specified number of +# max retries and delay between retries. Otherwise the 'elsescript' is +# executed. +proc wait_for_condition {maxtries delay e _else_ elsescript} { + while {[incr maxtries -1] >= 0} { + set errcode [catch {uplevel 1 [list expr $e]} result] + if {$errcode == 0} { + if {$result} break + } else { + return -code $errcode $result + } + after $delay + } + if {$maxtries == -1} { + set errcode [catch [uplevel 1 $elsescript] result] + return -code $errcode $result + } +} + +proc test {name code {okpattern undefined}} { + # abort if tagged with a tag to deny + foreach tag $::denytags { + if {[lsearch $::tags $tag] >= 0} { + return + } + } + + # check if tagged with at least 1 tag to allow when there *is* a list + # of tags to allow, because default policy is to run everything + if {[llength $::allowtags] > 0} { + set matched 0 + foreach tag $::allowtags { + if {[lsearch $::tags $tag] >= 0} { + incr matched + } + } + if {$matched < 1} { + return + } + } + + incr ::num_tests + set details {} + lappend details "$name in $::curfile" + + send_data_packet $::test_server_fd testing $name + + if {[catch {set retval [uplevel 1 $code]} error]} { + if {[string match "assertion:*" $error]} { + set msg [string range $error 10 end] + lappend details $msg + lappend ::tests_failed $details + + incr ::num_failed + send_data_packet $::test_server_fd err [join $details "\n"] + } else { + # Re-raise, let handler up the stack take care of this. + error $error $::errorInfo + } + } else { + if {$okpattern eq "undefined" || $okpattern eq $retval || [string match $okpattern $retval]} { + incr ::num_passed + send_data_packet $::test_server_fd ok $name + } else { + set msg "Expected '$okpattern' to equal or match '$retval'" + lappend details $msg + lappend ::tests_failed $details + + incr ::num_failed + send_data_packet $::test_server_fd err [join $details "\n"] + } + } + + if {$::traceleaks} { + set output [exec leaks redis-server] + if {![string match {*0 leaks*} $output]} { + send_data_packet $::test_server_fd err "Detected a memory leak in test '$name': $output" + } + } +} diff --git a/pikatests/tests/support/tmpfile.tcl b/pikatests/tests/support/tmpfile.tcl new file mode 100644 index 0000000000..809f587306 --- /dev/null +++ b/pikatests/tests/support/tmpfile.tcl @@ -0,0 +1,15 @@ +set ::tmpcounter 0 +set ::tmproot "./tests/tmp" +file mkdir $::tmproot + +# returns a dirname unique to this process to write to +proc tmpdir {basename} { + set dir [file join $::tmproot $basename.[pid].[incr ::tmpcounter]] + file mkdir $dir + set _ $dir +} + +# return a filename unique to this process to write to +proc tmpfile {basename} { + file join $::tmproot $basename.[pid].[incr ::tmpcounter] +} diff --git a/pikatests/tests/support/util.tcl b/pikatests/tests/support/util.tcl new file mode 100644 index 0000000000..cd5b9b511f --- /dev/null +++ b/pikatests/tests/support/util.tcl @@ -0,0 +1,371 @@ +proc randstring {min max {type binary}} { + set len [expr {$min+int(rand()*($max-$min+1))}] + set output {} + if {$type eq {binary}} { + set minval 0 + set maxval 255 + } elseif {$type eq {alpha}} { + set minval 48 + set maxval 122 + } elseif {$type eq {compr}} { + set minval 48 + set maxval 52 + } + while {$len} { + append output [format "%c" [expr {$minval+int(rand()*($maxval-$minval+1))}]] + incr len -1 + } + return $output +} + +# Useful for some test +proc zlistAlikeSort {a b} { + if {[lindex $a 0] > [lindex $b 0]} {return 1} + if {[lindex $a 0] < [lindex $b 0]} {return -1} + string compare [lindex $a 1] [lindex $b 1] +} + +# Return all log lines starting with the first line that contains a warning. +# Generally, this will be an assertion error with a stack trace. +proc warnings_from_file {filename} { + set lines [split [exec cat $filename] "\n"] + set matched 0 + set logall 0 + set result {} + foreach line $lines { + if {[string match {*REDIS BUG REPORT START*} $line]} { + set logall 1 + } + if {[regexp {^\[\d+\]\s+\d+\s+\w+\s+\d{2}:\d{2}:\d{2} \#} $line]} { + set matched 1 + } + if {$logall || $matched} { + lappend result $line + } + } + join $result "\n" +} + +# Return value for INFO property +proc status {r property} { + if {[regexp "\r\n$property:(.*?)\r\n" [{*}$r info] _ value]} { + set _ $value + } +} + +proc waitForBgsave r { + while 1 { + if {[status r rdb_bgsave_in_progress] eq 1} { + if {$::verbose} { + puts -nonewline "\nWaiting for background save to finish... " + flush stdout + } + after 1000 + } else { + break + } + } +} + +proc waitForBgrewriteaof r { + while 1 { + if {[status r aof_rewrite_in_progress] eq 1} { + if {$::verbose} { + puts -nonewline "\nWaiting for background AOF rewrite to finish... " + flush stdout + } + after 1000 + } else { + break + } + } +} + +proc wait_for_sync r { + while 1 { + if {[status $r master_link_status] eq "down"} { + after 10 + } else { + break + } + } +} + +# Random integer between 0 and max (excluded). +proc randomInt {max} { + expr {int(rand()*$max)} +} + +# Random signed integer between -max and max (both extremes excluded). +proc randomSignedInt {max} { + set i [randomInt $max] + if {rand() > 0.5} { + set i -$i + } + return $i +} + +proc randpath args { + set path [expr {int(rand()*[llength $args])}] + uplevel 1 [lindex $args $path] +} + +proc randomValue {} { + randpath { + # Small enough to likely collide + randomSignedInt 1000 + } { + # 32 bit compressible signed/unsigned + randpath {randomSignedInt 2000000000} {randomSignedInt 4000000000} + } { + # 64 bit + randpath {randomSignedInt 1000000000000} + } { + # Random string + randpath {randstring 0 256 alpha} \ + {randstring 0 256 compr} \ + {randstring 0 256 binary} + } +} + +proc randomKey {} { + randpath { + # Small enough to likely collide + randomInt 1000 + } { + # 32 bit compressible signed/unsigned + randpath {randomInt 2000000000} {randomInt 4000000000} + } { + # 64 bit + randpath {randomInt 1000000000000} + } { + # Random string + randpath {randstring 1 256 alpha} \ + {randstring 1 256 compr} + } +} + +proc findKeyWithType {r type} { + for {set j 0} {$j < 20} {incr j} { + set k [{*}$r randomkey] + if {$k eq {}} { + return {} + } + if {[{*}$r type $k] eq $type} { + return $k + } + } + return {} +} + +proc createComplexDataset {r ops {opt {}}} { + for {set j 0} {$j < $ops} {incr j} { + set k [randomKey] + set k2 [randomKey] + set f [randomValue] + set v [randomValue] + + if {[lsearch -exact $opt useexpire] != -1} { + if {rand() < 0.1} { + {*}$r expire [randomKey] [randomInt 2] + } + } + + randpath { + set d [expr {rand()}] + } { + set d [expr {rand()}] + } { + set d [expr {rand()}] + } { + set d [expr {rand()}] + } { + set d [expr {rand()}] + } { + randpath {set d +inf} {set d -inf} + } + set t [{*}$r type $k] + + if {$t eq {none}} { + randpath { + {*}$r set $k $v + } { + {*}$r lpush $k $v + } { + {*}$r sadd $k $v + } { + {*}$r zadd $k $d $v + } { + {*}$r hset $k $f $v + } { + {*}$r del $k + } + set t [{*}$r type $k] + } + + switch $t { + {string} { + # Nothing to do + } + {list} { + randpath {{*}$r lpush $k $v} \ + {{*}$r rpush $k $v} \ + {{*}$r lrem $k 0 $v} \ + {{*}$r rpop $k} \ + {{*}$r lpop $k} + } + {set} { + randpath {{*}$r sadd $k $v} \ + {{*}$r srem $k $v} \ + { + set otherset [findKeyWithType {*}$r set] + if {$otherset ne {}} { + randpath { + {*}$r sunionstore $k2 $k $otherset + } { + {*}$r sinterstore $k2 $k $otherset + } { + {*}$r sdiffstore $k2 $k $otherset + } + } + } + } + {zset} { + randpath {{*}$r zadd $k $d $v} \ + {{*}$r zrem $k $v} \ + { + set otherzset [findKeyWithType {*}$r zset] + if {$otherzset ne {}} { + randpath { + {*}$r zunionstore $k2 2 $k $otherzset + } { + {*}$r zinterstore $k2 2 $k $otherzset + } + } + } + } + {hash} { + randpath {{*}$r hset $k $f $v} \ + {{*}$r hdel $k $f} + } + } + } +} + +proc formatCommand {args} { + set cmd "*[llength $args]\r\n" + foreach a $args { + append cmd "$[string length $a]\r\n$a\r\n" + } + set _ $cmd +} + +proc csvdump r { + set o {} + foreach k [lsort [{*}$r keys *]] { + set type [{*}$r type $k] + append o [csvstring $k] , [csvstring $type] , + switch $type { + string { + append o [csvstring [{*}$r get $k]] "\n" + } + list { + foreach e [{*}$r lrange $k 0 -1] { + append o [csvstring $e] , + } + append o "\n" + } + set { + foreach e [lsort [{*}$r smembers $k]] { + append o [csvstring $e] , + } + append o "\n" + } + zset { + foreach e [{*}$r zrange $k 0 -1 withscores] { + append o [csvstring $e] , + } + append o "\n" + } + hash { + set fields [{*}$r hgetall $k] + set newfields {} + foreach {k v} $fields { + lappend newfields [list $k $v] + } + set fields [lsort -index 0 $newfields] + foreach kv $fields { + append o [csvstring [lindex $kv 0]] , + append o [csvstring [lindex $kv 1]] , + } + append o "\n" + } + } + } + return $o +} + +proc csvstring s { + return "\"$s\"" +} + +proc roundFloat f { + format "%.10g" $f +} + +proc find_available_port start { + for {set j $start} {$j < $start+1024} {incr j} { + if {[catch { + set fd [socket 127.0.0.1 $j] + }]} { + return $j + } else { + close $fd + } + } + if {$j == $start+1024} { + error "Can't find a non busy port in the $start-[expr {$start+1023}] range." + } +} + +# Test if TERM looks like to support colors +proc color_term {} { + expr {[info exists ::env(TERM)] && [string match *xterm* $::env(TERM)]} +} + +proc colorstr {color str} { + if {[color_term]} { + set b 0 + if {[string range $color 0 4] eq {bold-}} { + set b 1 + set color [string range $color 5 end] + } + switch $color { + red {set colorcode {31}} + green {set colorcode {32}} + yellow {set colorcode {33}} + blue {set colorcode {34}} + magenta {set colorcode {35}} + cyan {set colorcode {36}} + white {set colorcode {37}} + default {set colorcode {37}} + } + if {$colorcode ne {}} { + return "\033\[$b;${colorcode};49m$str\033\[0m" + } + } else { + return $str + } +} + +# Execute a background process writing random data for the specified number +# of seconds to the specified Redis instance. +proc start_write_load {host port seconds} { + set tclsh [info nameofexecutable] + exec $tclsh tests/helpers/gen_write_load.tcl $host $port $seconds & +} + +# Stop a process generating write load executed with start_write_load. +proc stop_write_load {handle} { + catch {exec /bin/kill -9 $handle} +} diff --git a/pikatests/tests/test_helper.tcl b/pikatests/tests/test_helper.tcl new file mode 100644 index 0000000000..d1ebde1c48 --- /dev/null +++ b/pikatests/tests/test_helper.tcl @@ -0,0 +1,545 @@ +# Redis test suite. Copyright (C) 2009 Salvatore Sanfilippo antirez@gmail.com +# This software is released under the BSD License. See the COPYING file for +# more information. + +package require Tcl 8.5 + +set tcl_precision 17 +source tests/support/redis.tcl +source tests/support/server.tcl +source tests/support/tmpfile.tcl +source tests/support/test.tcl +source tests/support/util.tcl + +set ::all_tests { + unit/printver + unit/auth + unit/protocol + unit/basic + unit/scan + unit/type/list + unit/type/list-2 + unit/type/list-3 + unit/type/set + unit/type/zset + unit/type/hash + unit/sort + unit/expire + unit/other + unit/multi + unit/quit + unit/aofrw + integration/replication + integration/replication-2 + integration/replication-3 + integration/replication-4 + integration/replication-psync + integration/aof + integration/rdb + integration/convert-zipmap-hash-on-load + unit/pubsub + unit/slowlog + unit/scripting + unit/maxmemory + unit/introspection + unit/limits + unit/obuf-limits + unit/dump + unit/bitops + unit/memefficiency + unit/hyperloglog +} +# Index to the next test to run in the ::all_tests list. +set ::next_test 0 + +set ::host 127.0.0.1 +set ::port 21111 +set ::traceleaks 0 +set ::valgrind 0 +set ::verbose 0 +set ::quiet 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 ::curfile ""; # Hold the filename of the current suite +set ::accurate 0; # If true runs fuzz tests with more iterations +set ::force_failure 0 +set ::timeout 600; # 10 minutes without progresses will quit the test. +set ::last_progress [clock seconds] +set ::active_servers {} ; # Pids of active Redis instances. + +# Set to 1 when we are running in client mode. The Redis test uses a +# server-client model to run tests simultaneously. The server instance +# runs the specified number of client instances that will actually run tests. +# The server is responsible of showing the result to the user, and exit with +# the appropriate exit code depending on the test outcome. +set ::client 0 +set ::numclients 16 + +proc execute_tests name { + set path "tests/$name.tcl" + set ::curfile $path + source $path + send_data_packet $::test_server_fd done "$name" +} + +# Setup a list to hold a stack of server configs. When calls to start_server +# are nested, use "srv 0 pid" to get the pid of the inner server. To access +# outer servers, use "srv -1 pid" etcetera. +set ::servers {} +proc srv {args} { + set level 0 + if {[string is integer [lindex $args 0]]} { + set level [lindex $args 0] + set property [lindex $args 1] + } else { + set property [lindex $args 0] + } + set srv [lindex $::servers end+$level] + dict get $srv $property +} + +# Provide easy access to the client for the inner server. It's possible to +# prepend the argument list with a negative level to access clients for +# servers running in outer blocks. +proc r {args} { + set level 0 + if {[string is integer [lindex $args 0]]} { + set level [lindex $args 0] + set args [lrange $args 1 end] + } + [srv $level "client"] {*}$args +} + +proc reconnect {args} { + set level [lindex $args 0] + if {[string length $level] == 0 || ![string is integer $level]} { + set level 0 + } + + set srv [lindex $::servers end+$level] + set host [dict get $srv "host"] + set port [dict get $srv "port"] + set config [dict get $srv "config"] + set client [redis $host $port] + dict set srv "client" $client + + # select the right db when we don't have to authenticate + if {![dict exists $config "requirepass"]} { + $client select 9 + } + + # re-set $srv in the servers list + lset ::servers end+$level $srv +} + +proc redis_deferring_client {args} { + set level 0 + if {[llength $args] > 0 && [string is integer [lindex $args 0]]} { + set level [lindex $args 0] + set args [lrange $args 1 end] + } + + # create client that defers reading reply + set client [redis [srv $level "host"] [srv $level "port"] 1] + + # select the right db and read the response (OK) + $client select 9 + $client read + return $client +} + +# Provide easy access to INFO properties. Same semantic as "proc r". +proc s {args} { + set level 0 + if {[string is integer [lindex $args 0]]} { + set level [lindex $args 0] + set args [lrange $args 1 end] + } + status [srv $level "client"] [lindex $args 0] +} + +proc cleanup {} { + if {!$::quiet} {puts -nonewline "Cleanup: may take some time... "} + flush stdout + catch {exec rm -rf {*}[glob tests/tmp/redis.conf.*]} + catch {exec rm -rf {*}[glob tests/tmp/server.*]} + if {!$::quiet} {puts "OK"} +} + +proc test_server_main {} { + cleanup + set tclsh [info nameofexecutable] + # Open a listening socket, trying different ports in order to find a + # non busy one. + set port [find_available_port 11111] + if {!$::quiet} { + puts "Starting test server at port $port" + } + socket -server accept_test_clients -myaddr 127.0.0.1 $port + + # Start the client instances + set ::clients_pids {} + set start_port [expr {$::port+100}] + for {set j 0} {$j < $::numclients} {incr j} { + set start_port [find_available_port $start_port] + set p [exec $tclsh [info script] {*}$::argv \ + --client $port --port $start_port &] + lappend ::clients_pids $p + incr start_port 10 + } + + # Setup global state for the test server + set ::idle_clients {} + set ::active_clients {} + array set ::active_clients_task {} + array set ::clients_start_time {} + set ::clients_time_history {} + set ::failed_tests {} + + # Enter the event loop to handle clients I/O + after 100 test_server_cron + vwait forever +} + +# This function gets called 10 times per second. +proc test_server_cron {} { + set elapsed [expr {[clock seconds]-$::last_progress}] + + if {$elapsed > $::timeout} { + set err "\[[colorstr red TIMEOUT]\]: clients state report follows." + puts $err + show_clients_state + kill_clients + force_kill_all_servers + the_end + } + + after 100 test_server_cron +} + +proc accept_test_clients {fd addr port} { + fconfigure $fd -encoding binary + fileevent $fd readable [list read_from_test_client $fd] +} + +# This is the readable handler of our test server. Clients send us messages +# in the form of a status code such and additional data. Supported +# status types are: +# +# ready: the client is ready to execute the command. Only sent at client +# startup. The server will queue the client FD in the list of idle +# clients. +# testing: just used to signal that a given test started. +# ok: a test was executed with success. +# err: a test was executed with an error. +# exception: there was a runtime exception while executing the test. +# done: all the specified test file was processed, this test client is +# ready to accept a new task. +proc read_from_test_client fd { + set bytes [gets $fd] + set payload [read $fd $bytes] + foreach {status data} $payload break + set ::last_progress [clock seconds] + + if {$status eq {ready}} { + if {!$::quiet} { + puts "\[$status\]: $data" + } + signal_idle_client $fd + } elseif {$status eq {done}} { + set elapsed [expr {[clock seconds]-$::clients_start_time($fd)}] + set all_tests_count [llength $::all_tests] + set running_tests_count [expr {[llength $::active_clients]-1}] + set completed_tests_count [expr {$::next_test-$running_tests_count}] + puts "\[$completed_tests_count/$all_tests_count [colorstr yellow $status]\]: $data ($elapsed seconds)" + lappend ::clients_time_history $elapsed $data + signal_idle_client $fd + set ::active_clients_task($fd) DONE + } elseif {$status eq {ok}} { + if {!$::quiet} { + puts "\[[colorstr green $status]\]: $data" + } + set ::active_clients_task($fd) "(OK) $data" + } elseif {$status eq {err}} { + set err "\[[colorstr red $status]\]: $data" + puts $err + lappend ::failed_tests $err + set ::active_clients_task($fd) "(ERR) $data" + } elseif {$status eq {exception}} { + puts "\[[colorstr red $status]\]: $data" + kill_clients + force_kill_all_servers + exit 1 + } elseif {$status eq {testing}} { + set ::active_clients_task($fd) "(IN PROGRESS) $data" + } elseif {$status eq {server-spawned}} { + lappend ::active_servers $data + } elseif {$status eq {server-killed}} { + set ::active_servers [lsearch -all -inline -not -exact $::active_servers $data] + } else { + if {!$::quiet} { + puts "\[$status\]: $data" + } + } +} + +proc show_clients_state {} { + # The following loop is only useful for debugging tests that may + # enter an infinite loop. Commented out normally. + foreach x $::active_clients { + if {[info exist ::active_clients_task($x)]} { + puts "$x => $::active_clients_task($x)" + } else { + puts "$x => ???" + } + } +} + +proc kill_clients {} { + foreach p $::clients_pids { + catch {exec kill $p} + } +} + +proc force_kill_all_servers {} { + foreach p $::active_servers { + puts "Killing still running Redis server $p" + catch {exec kill -9 $p} + } +} + +# A new client is idle. Remove it from the list of active clients and +# if there are still test units to run, launch them. +proc signal_idle_client fd { + # Remove this fd from the list of active clients. + set ::active_clients \ + [lsearch -all -inline -not -exact $::active_clients $fd] + + if 0 {show_clients_state} + + # New unit to process? + if {$::next_test != [llength $::all_tests]} { + if {!$::quiet} { + puts [colorstr bold-white "Testing [lindex $::all_tests $::next_test]"] + set ::active_clients_task($fd) "ASSIGNED: $fd ([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 + incr ::next_test + } else { + lappend ::idle_clients $fd + if {[llength $::active_clients] == 0} { + the_end + } + } +} + +# The the_end function gets called when all the test units were already +# executed, so the test finished. +proc the_end {} { + # TODO: print the status, exit with the rigth exit code. + puts "\n The End\n" + puts "Execution time of different units:" + foreach {time name} $::clients_time_history { + puts " $time seconds - $name" + } + if {[llength $::failed_tests]} { + puts "\n[colorstr bold-red {!!! WARNING}] The following tests failed:\n" + foreach failed $::failed_tests { + puts "*** $failed" + } + cleanup + exit 1 + } else { + puts "\n[colorstr bold-white {\o/}] [colorstr bold-green {All tests passed without errors!}]\n" + cleanup + exit 0 + } +} + +# The client is not even driven (the test server is instead) as we just need +# to read the command, execute, reply... all this in a loop. +proc test_client_main server_port { + set ::test_server_fd [socket localhost $server_port] + fconfigure $::test_server_fd -encoding binary + send_data_packet $::test_server_fd ready [pid] + while 1 { + set bytes [gets $::test_server_fd] + set payload [read $::test_server_fd $bytes] + foreach {cmd data} $payload break + if {$cmd eq {run}} { + execute_tests $data + } else { + error "Unknown test client command: $cmd" + } + } +} + +proc send_data_packet {fd status data} { + set payload [list $status $data] + puts $fd [string length $payload] + puts -nonewline $fd $payload + flush $fd +} + +proc print_help_screen {} { + puts [join { + "--valgrind Run the test over valgrind." + "--accurate Run slow randomized tests for more iterations." + "--quiet Don't show individual tests." + "--single Just execute the specified unit (see next option)." + "--list-tests List all the available test units." + "--clients Number of test clients (default 16)." + "--timeout Test timeout in seconds (default 10 min)." + "--force-failure Force the execution of a test that always fails." + "--help Print this help screen." + } "\n"] +} + +# parse arguments +for {set j 0} {$j < [llength $argv]} {incr j} { + set opt [lindex $argv $j] + set arg [lindex $argv [expr $j+1]] + if {$opt eq {--tags}} { + foreach tag $arg { + if {[string index $tag 0] eq "-"} { + lappend ::denytags [string range $tag 1 end] + } else { + lappend ::allowtags $tag + } + } + incr j + } elseif {$opt eq {--valgrind}} { + set ::valgrind 1 + } elseif {$opt eq {--quiet}} { + set ::quiet 1 + } elseif {$opt eq {--host}} { + set ::external 1 + set ::host $arg + incr j + } elseif {$opt eq {--port}} { + set ::port $arg + incr j + } elseif {$opt eq {--accurate}} { + set ::accurate 1 + } elseif {$opt eq {--force-failure}} { + set ::force_failure 1 + } elseif {$opt eq {--single}} { + set ::all_tests $arg + incr j + } elseif {$opt eq {--list-tests}} { + foreach t $::all_tests { + puts $t + } + exit 0 + } elseif {$opt eq {--client}} { + set ::client 1 + set ::test_server_port $arg + incr j + } elseif {$opt eq {--clients}} { + set ::numclients $arg + incr j + } elseif {$opt eq {--timeout}} { + set ::timeout $arg + incr j + } elseif {$opt eq {--help}} { + print_help_screen + exit 0 + } else { + puts "Wrong argument: $opt" + exit 1 + } +} + +proc attach_to_replication_stream {} { + set s [socket [srv 0 "host"] [srv 0 "port"]] + fconfigure $s -translation binary + puts -nonewline $s "SYNC\r\n" + flush $s + + # Get the count + set count [gets $s] + set prefix [string range $count 0 0] + if {$prefix ne {$}} { + error "attach_to_replication_stream error. Received '$count' as count." + } + set count [string range $count 1 end] + + # Consume the bulk payload + while {$count} { + set buf [read $s $count] + set count [expr {$count-[string length $buf]}] + } + return $s +} + +proc read_from_replication_stream {s} { + fconfigure $s -blocking 0 + set attempt 0 + while {[gets $s count] == -1} { + if {[incr attempt] == 10} return "" + after 100 + } + fconfigure $s -blocking 1 + set count [string range $count 1 end] + + # Return a list of arguments for the command. + set res {} + for {set j 0} {$j < $count} {incr j} { + read $s 1 + set arg [::redis::redis_bulk_read $s] + if {$j == 0} {set arg [string tolower $arg]} + lappend res $arg + } + return $res +} + +proc assert_replication_stream {s patterns} { + for {set j 0} {$j < [llength $patterns]} {incr j} { + assert_match [lindex $patterns $j] [read_from_replication_stream $s] + } +} + +proc close_replication_stream {s} { + close $s +} + +# With the parallel test running multiple Redis instances at the same time +# we need a fast enough computer, otherwise a lot of tests may generate +# false positives. +# If the computer is too slow we revert the sequential test without any +# parallelism, that is, clients == 1. +proc is_a_slow_computer {} { + set start [clock milliseconds] + for {set j 0} {$j < 1000000} {incr j} {} + set elapsed [expr [clock milliseconds]-$start] + expr {$elapsed > 200} +} + +if {$::client} { + if {[catch { test_client_main $::test_server_port } err]} { + set estr "Executing test client: $err.\n$::errorInfo" + if {[catch {send_data_packet $::test_server_fd exception $estr}]} { + puts $estr + } + exit 1 + } +} else { + if {[is_a_slow_computer]} { + puts "** SLOW COMPUTER ** Using a single client to avoid false positives." + set ::numclients 1 + } + + if {[catch { test_server_main } err]} { + if {[string length $err] > 0} { + # only display error when not generated by the test suite + if {$err ne "exception"} { + puts $::errorInfo + } + exit 1 + } + } +} diff --git a/pikatests/tests/unit/aofrw.tcl b/pikatests/tests/unit/aofrw.tcl new file mode 100644 index 0000000000..a2d74168f3 --- /dev/null +++ b/pikatests/tests/unit/aofrw.tcl @@ -0,0 +1,210 @@ +start_server {tags {"aofrw"}} { + # Enable the AOF + r config set appendonly yes + r config set auto-aof-rewrite-percentage 0 ; # Disable auto-rewrite. + waitForBgrewriteaof r + + test {AOF rewrite during write load} { + # Start a write load for 10 seconds + set master [srv 0 client] + set master_host [srv 0 host] + set master_port [srv 0 port] + set load_handle0 [start_write_load $master_host $master_port 10] + set load_handle1 [start_write_load $master_host $master_port 10] + set load_handle2 [start_write_load $master_host $master_port 10] + set load_handle3 [start_write_load $master_host $master_port 10] + set load_handle4 [start_write_load $master_host $master_port 10] + + # Make sure the instance is really receiving data + wait_for_condition 50 100 { + [r dbsize] > 0 + } else { + fail "No write load detected." + } + + # After 3 seconds, start a rewrite, while the write load is still + # active. + after 3000 + r bgrewriteaof + waitForBgrewriteaof r + + # Let it run a bit more so that we'll append some data to the new + # AOF. + after 1000 + + # Stop the processes generating the load if they are still active + stop_write_load $load_handle0 + stop_write_load $load_handle1 + stop_write_load $load_handle2 + stop_write_load $load_handle3 + stop_write_load $load_handle4 + + # Make sure that we remain the only connected client. + # This step is needed to make sure there are no pending writes + # that will be processed between the two "debug digest" calls. + wait_for_condition 50 100 { + [llength [split [string trim [r client list]] "\n"]] == 1 + } else { + puts [r client list] + fail "Clients generating loads are not disconnecting" + } + + # Get the data set digest + set d1 [r debug digest] + + # Load the AOF + r debug loadaof + set d2 [r debug digest] + + # Make sure they are the same + assert {$d1 eq $d2} + } +} + +start_server {tags {"aofrw"}} { + test {Turning off AOF kills the background writing child if any} { + r config set appendonly yes + waitForBgrewriteaof r + r multi + r bgrewriteaof + r config set appendonly no + r exec + wait_for_condition 50 100 { + [string match {*Killing*AOF*child*} [exec tail -n5 < [srv 0 stdout]]] + } else { + fail "Can't find 'Killing AOF child' into recent logs" + } + } + + foreach d {string int} { + foreach e {ziplist linkedlist} { + test "AOF rewrite of list with $e encoding, $d data" { + r flushall + if {$e eq {ziplist}} {set len 10} else {set len 1000} + for {set j 0} {$j < $len} {incr j} { + if {$d eq {string}} { + set data [randstring 0 16 alpha] + } else { + set data [randomInt 4000000000] + } + r lpush key $data + } + assert_equal [r object encoding key] $e + set d1 [r debug digest] + r bgrewriteaof + waitForBgrewriteaof r + r debug loadaof + set d2 [r debug digest] + if {$d1 ne $d2} { + error "assertion:$d1 is not equal to $d2" + } + } + } + } + + foreach d {string int} { + foreach e {intset hashtable} { + test "AOF rewrite of set with $e encoding, $d data" { + r flushall + if {$e eq {intset}} {set len 10} else {set len 1000} + for {set j 0} {$j < $len} {incr j} { + if {$d eq {string}} { + set data [randstring 0 16 alpha] + } else { + set data [randomInt 4000000000] + } + r sadd key $data + } + if {$d ne {string}} { + assert_equal [r object encoding key] $e + } + set d1 [r debug digest] + r bgrewriteaof + waitForBgrewriteaof r + r debug loadaof + set d2 [r debug digest] + if {$d1 ne $d2} { + error "assertion:$d1 is not equal to $d2" + } + } + } + } + + foreach d {string int} { + foreach e {ziplist hashtable} { + test "AOF rewrite of hash with $e encoding, $d data" { + r flushall + if {$e eq {ziplist}} {set len 10} else {set len 1000} + for {set j 0} {$j < $len} {incr j} { + if {$d eq {string}} { + set data [randstring 0 16 alpha] + } else { + set data [randomInt 4000000000] + } + r hset key $data $data + } + assert_equal [r object encoding key] $e + set d1 [r debug digest] + r bgrewriteaof + waitForBgrewriteaof r + r debug loadaof + set d2 [r debug digest] + if {$d1 ne $d2} { + error "assertion:$d1 is not equal to $d2" + } + } + } + } + + foreach d {string int} { + foreach e {ziplist skiplist} { + test "AOF rewrite of zset with $e encoding, $d data" { + r flushall + if {$e eq {ziplist}} {set len 10} else {set len 1000} + for {set j 0} {$j < $len} {incr j} { + if {$d eq {string}} { + set data [randstring 0 16 alpha] + } else { + set data [randomInt 4000000000] + } + r zadd key [expr rand()] $data + } + assert_equal [r object encoding key] $e + set d1 [r debug digest] + r bgrewriteaof + waitForBgrewriteaof r + r debug loadaof + set d2 [r debug digest] + if {$d1 ne $d2} { + error "assertion:$d1 is not equal to $d2" + } + } + } + } + + test {BGREWRITEAOF is delayed if BGSAVE is in progress} { + r multi + r bgsave + r bgrewriteaof + r info persistence + set res [r exec] + assert_match {*scheduled*} [lindex $res 1] + assert_match {*aof_rewrite_scheduled:1*} [lindex $res 2] + while {[string match {*aof_rewrite_scheduled:1*} [r info persistence]]} { + after 100 + } + } + + test {BGREWRITEAOF is refused if already in progress} { + catch { + r multi + r bgrewriteaof + r bgrewriteaof + r exec + } e + assert_match {*ERR*already*} $e + while {[string match {*aof_rewrite_scheduled:1*} [r info persistence]]} { + after 100 + } + } +} diff --git a/pikatests/tests/unit/auth.tcl b/pikatests/tests/unit/auth.tcl new file mode 100644 index 0000000000..633cda95c9 --- /dev/null +++ b/pikatests/tests/unit/auth.tcl @@ -0,0 +1,27 @@ +start_server {tags {"auth"}} { + test {AUTH fails if there is no password configured server side} { + catch {r auth foo} err + set _ $err + } {ERR*no password*} +} + +start_server {tags {"auth"} overrides {requirepass foobar}} { + test {AUTH fails when a wrong password is given} { + catch {r auth wrong!} err + set _ $err + } {ERR*invalid password} + + test {Arbitrary command gives an error when AUTH is required} { + catch {r set foo bar} err + set _ $err + } {NOAUTH*} + + test {AUTH succeeds when the right password is given} { + r auth foobar + } {OK} + + test {Once AUTH succeeded we can actually send commands to the server} { + r set foo 100 + r incr foo + } {101} +} diff --git a/pikatests/tests/unit/basic.tcl b/pikatests/tests/unit/basic.tcl new file mode 100644 index 0000000000..6f725d299b --- /dev/null +++ b/pikatests/tests/unit/basic.tcl @@ -0,0 +1,783 @@ +start_server {tags {"basic"}} { + test {DEL all keys to start with a clean DB} { + foreach key [r keys *] {r del $key} + r dbsize + } {0} + + test {SET and GET an item} { + r set x foobar + r get x + } {foobar} + + test {SET and GET an empty item} { + r set x {} + r get x + } {} + + test {DEL against a single item} { + r del x + r get x + } {} + + test {Vararg DEL} { + r set foo1 a + r set foo2 b + r set foo3 c + list [r del foo1 foo2 foo3 foo4] [r mget foo1 foo2 foo3] + } {3 {{} {} {}}} + + test {KEYS with pattern} { + foreach key {key_x key_y key_z foo_a foo_b foo_c} { + r set $key hello + } + lsort [r keys foo*] + } {foo_a foo_b foo_c} + + test {KEYS to get all keys} { + lsort [r keys *] + } {foo_a foo_b foo_c key_x key_y key_z} + + test {DBSIZE} { + r dbsize + } {6} + + test {DEL all keys} { + foreach key [r keys *] {r del $key} + r dbsize + } {0} + + test {Very big payload in GET/SET} { + set buf [string repeat "abcd" 1000000] + r set foo $buf + r get foo + } [string repeat "abcd" 1000000] + + tags {"slow"} { + test {Very big payload random access} { + set err {} + array set payload {} + for {set j 0} {$j < 100} {incr j} { + set size [expr 1+[randomInt 100000]] + set buf [string repeat "pl-$j" $size] + set payload($j) $buf + r set bigpayload_$j $buf + } + for {set j 0} {$j < 1000} {incr j} { + set index [randomInt 100] + set buf [r get bigpayload_$index] + if {$buf != $payload($index)} { + set err "Values differ: I set '$payload($index)' but I read back '$buf'" + break + } + } + unset payload + set _ $err + } {} + + test {SET 10000 numeric keys and access all them in reverse order} { + set err {} + for {set x 0} {$x < 10000} {incr x} { + r set $x $x + } + set sum 0 + for {set x 9999} {$x >= 0} {incr x -1} { + set val [r get $x] + if {$val ne $x} { + set err "Element at position $x is $val instead of $x" + break + } + } + set _ $err + } {} + + test {DBSIZE should be 10101 now} { + r dbsize + } {10101} + } + + test {INCR against non existing key} { + set res {} + append res [r incr novar] + append res [r get novar] + } {11} + + test {INCR against key created by incr itself} { + r incr novar + } {2} + + test {INCR against key originally set with SET} { + r set novar 100 + r incr novar + } {101} + + test {INCR over 32bit value} { + r set novar 17179869184 + r incr novar + } {17179869185} + + test {INCRBY over 32bit value with over 32bit increment} { + r set novar 17179869184 + r incrby novar 17179869184 + } {34359738368} + + test {INCR fails against key with spaces (left)} { + r set novar " 11" + catch {r incr novar} err + format $err + } {ERR*} + + test {INCR fails against key with spaces (right)} { + r set novar "11 " + catch {r incr novar} err + format $err + } {ERR*} + + test {INCR fails against key with spaces (both)} { + r set novar " 11 " + catch {r incr novar} err + format $err + } {ERR*} + + test {INCR fails against a key holding a list} { + r rpush mylist 1 + catch {r incr mylist} err + r rpop mylist + format $err + } {WRONGTYPE*} + + test {DECRBY over 32bit value with over 32bit increment, negative res} { + r set novar 17179869184 + r decrby novar 17179869185 + } {-1} + + test {INCRBYFLOAT against non existing key} { + r del novar + list [roundFloat [r incrbyfloat novar 1]] \ + [roundFloat [r get novar]] \ + [roundFloat [r incrbyfloat novar 0.25]] \ + [roundFloat [r get novar]] + } {1 1 1.25 1.25} + + test {INCRBYFLOAT against key originally set with SET} { + r set novar 1.5 + roundFloat [r incrbyfloat novar 1.5] + } {3} + + test {INCRBYFLOAT over 32bit value} { + r set novar 17179869184 + r incrbyfloat novar 1.5 + } {17179869185.5} + + test {INCRBYFLOAT over 32bit value with over 32bit increment} { + r set novar 17179869184 + r incrbyfloat novar 17179869184 + } {34359738368} + + test {INCRBYFLOAT fails against key with spaces (left)} { + set err {} + r set novar " 11" + catch {r incrbyfloat novar 1.0} err + format $err + } {ERR*valid*} + + test {INCRBYFLOAT fails against key with spaces (right)} { + set err {} + r set novar "11 " + catch {r incrbyfloat novar 1.0} err + format $err + } {ERR*valid*} + + test {INCRBYFLOAT fails against key with spaces (both)} { + set err {} + r set novar " 11 " + catch {r incrbyfloat novar 1.0} err + format $err + } {ERR*valid*} + + test {INCRBYFLOAT fails against a key holding a list} { + r del mylist + set err {} + r rpush mylist 1 + catch {r incrbyfloat mylist 1.0} err + r del mylist + format $err + } {WRONGTYPE*} + + test {INCRBYFLOAT does not allow NaN or Infinity} { + r set foo 0 + set err {} + catch {r incrbyfloat foo +inf} err + set err + # p.s. no way I can force NaN to test it from the API because + # there is no way to increment / decrement by infinity nor to + # perform divisions. + } {ERR*would produce*} + + test {INCRBYFLOAT decrement} { + r set foo 1 + roundFloat [r incrbyfloat foo -1.1] + } {-0.1} + + test "SETNX target key missing" { + r del novar + assert_equal 1 [r setnx novar foobared] + assert_equal "foobared" [r get novar] + } + + test "SETNX target key exists" { + r set novar foobared + assert_equal 0 [r setnx novar blabla] + assert_equal "foobared" [r get novar] + } + + test "SETNX against not-expired volatile key" { + r set x 10 + r expire x 10000 + assert_equal 0 [r setnx x 20] + assert_equal 10 [r get x] + } + + test "SETNX against expired volatile key" { + # Make it very unlikely for the key this test uses to be expired by the + # active expiry cycle. This is tightly coupled to the implementation of + # active expiry and dbAdd() but currently the only way to test that + # SETNX expires a key when it should have been. + for {set x 0} {$x < 9999} {incr x} { + r setex key-$x 3600 value + } + + # This will be one of 10000 expiring keys. A cycle is executed every + # 100ms, sampling 10 keys for being expired or not. This key will be + # expired for at most 1s when we wait 2s, resulting in a total sample + # of 100 keys. The probability of the success of this test being a + # false positive is therefore approx. 1%. + r set x 10 + r expire x 1 + + # Wait for the key to expire + after 2000 + + assert_equal 1 [r setnx x 20] + assert_equal 20 [r get x] + } + + test "DEL against expired key" { + r debug set-active-expire 0 + r setex keyExpire 1 valExpire + after 1100 + assert_equal 0 [r del keyExpire] + r debug set-active-expire 1 + } + + test {EXISTS} { + set res {} + r set newkey test + append res [r exists newkey] + r del newkey + append res [r exists newkey] + } {10} + + test {Zero length value in key. SET/GET/EXISTS} { + r set emptykey {} + set res [r get emptykey] + append res [r exists emptykey] + r del emptykey + append res [r exists emptykey] + } {10} + + test {Commands pipelining} { + set fd [r channel] + puts -nonewline $fd "SET k1 xyzk\r\nGET k1\r\nPING\r\n" + flush $fd + set res {} + append res [string match OK* [r read]] + append res [r read] + append res [string match PONG* [r read]] + format $res + } {1xyzk1} + + test {Non existing command} { + catch {r foobaredcommand} err + string match ERR* $err + } {1} + + test {RENAME basic usage} { + r set mykey hello + r rename mykey mykey1 + r rename mykey1 mykey2 + r get mykey2 + } {hello} + + test {RENAME source key should no longer exist} { + r exists mykey + } {0} + + test {RENAME against already existing key} { + r set mykey a + r set mykey2 b + r rename mykey2 mykey + set res [r get mykey] + append res [r exists mykey2] + } {b0} + + test {RENAMENX basic usage} { + r del mykey + r del mykey2 + r set mykey foobar + r renamenx mykey mykey2 + set res [r get mykey2] + append res [r exists mykey] + } {foobar0} + + test {RENAMENX against already existing key} { + r set mykey foo + r set mykey2 bar + r renamenx mykey mykey2 + } {0} + + test {RENAMENX against already existing key (2)} { + set res [r get mykey] + append res [r get mykey2] + } {foobar} + + test {RENAME against non existing source key} { + catch {r rename nokey foobar} err + format $err + } {ERR*} + + test {RENAME where source and dest key is the same} { + catch {r rename mykey mykey} err + format $err + } {ERR*} + + test {RENAME with volatile key, should move the TTL as well} { + r del mykey mykey2 + r set mykey foo + r expire mykey 100 + assert {[r ttl mykey] > 95 && [r ttl mykey] <= 100} + r rename mykey mykey2 + assert {[r ttl mykey2] > 95 && [r ttl mykey2] <= 100} + } + + test {RENAME with volatile key, should not inherit TTL of target key} { + r del mykey mykey2 + r set mykey foo + r set mykey2 bar + r expire mykey2 100 + assert {[r ttl mykey] == -1 && [r ttl mykey2] > 0} + r rename mykey mykey2 + r ttl mykey2 + } {-1} + + test {DEL all keys again (DB 0)} { + foreach key [r keys *] { + r del $key + } + r dbsize + } {0} + + test {DEL all keys again (DB 1)} { + r select 10 + foreach key [r keys *] { + r del $key + } + set res [r dbsize] + r select 9 + format $res + } {0} + + test {MOVE basic usage} { + r set mykey foobar + r move mykey 10 + set res {} + lappend res [r exists mykey] + lappend res [r dbsize] + r select 10 + lappend res [r get mykey] + lappend res [r dbsize] + r select 9 + format $res + } [list 0 0 foobar 1] + + test {MOVE against key existing in the target DB} { + r set mykey hello + r move mykey 10 + } {0} + + test {MOVE against non-integer DB (#1428)} { + r set mykey hello + catch {r move mykey notanumber} e + set e + } {*ERR*index out of range} + + test {SET/GET keys in different DBs} { + r set a hello + r set b world + r select 10 + r set a foo + r set b bared + r select 9 + set res {} + lappend res [r get a] + lappend res [r get b] + r select 10 + lappend res [r get a] + lappend res [r get b] + r select 9 + format $res + } {hello world foo bared} + + test {MGET} { + r flushdb + r set foo BAR + r set bar FOO + r mget foo bar + } {BAR FOO} + + test {MGET against non existing key} { + r mget foo baazz bar + } {BAR {} FOO} + + test {MGET against non-string key} { + r sadd myset ciao + r sadd myset bau + r mget foo baazz bar myset + } {BAR {} FOO {}} + + test {RANDOMKEY} { + r flushdb + r set foo x + r set bar y + set foo_seen 0 + set bar_seen 0 + for {set i 0} {$i < 100} {incr i} { + set rkey [r randomkey] + if {$rkey eq {foo}} { + set foo_seen 1 + } + if {$rkey eq {bar}} { + set bar_seen 1 + } + } + list $foo_seen $bar_seen + } {1 1} + + test {RANDOMKEY against empty DB} { + r flushdb + r randomkey + } {} + + test {RANDOMKEY regression 1} { + r flushdb + r set x 10 + r del x + r randomkey + } {} + + test {GETSET (set new value)} { + list [r getset foo xyz] [r get foo] + } {{} xyz} + + test {GETSET (replace old value)} { + r set foo bar + list [r getset foo xyz] [r get foo] + } {bar xyz} + + test {MSET base case} { + r mset x 10 y "foo bar" z "x x x x x x x\n\n\r\n" + r mget x y z + } [list 10 {foo bar} "x x x x x x x\n\n\r\n"] + + test {MSET wrong number of args} { + catch {r mset x 10 y "foo bar" z} err + format $err + } {*wrong number*} + + test {MSETNX with already existent key} { + list [r msetnx x1 xxx y2 yyy x 20] [r exists x1] [r exists y2] + } {0 0 0} + + test {MSETNX with not existing keys} { + list [r msetnx x1 xxx y2 yyy] [r get x1] [r get y2] + } {1 xxx yyy} + + test "STRLEN against non-existing key" { + assert_equal 0 [r strlen notakey] + } + + test "STRLEN against integer-encoded value" { + r set myinteger -555 + assert_equal 4 [r strlen myinteger] + } + + test "STRLEN against plain string" { + r set mystring "foozzz0123456789 baz" + assert_equal 20 [r strlen mystring] + } + + test "SETBIT against non-existing key" { + r del mykey + assert_equal 0 [r setbit mykey 1 1] + assert_equal [binary format B* 01000000] [r get mykey] + } + + test "SETBIT against string-encoded key" { + # Ascii "@" is integer 64 = 01 00 00 00 + r set mykey "@" + + assert_equal 0 [r setbit mykey 2 1] + assert_equal [binary format B* 01100000] [r get mykey] + assert_equal 1 [r setbit mykey 1 0] + assert_equal [binary format B* 00100000] [r get mykey] + } + + test "SETBIT against integer-encoded key" { + # Ascii "1" is integer 49 = 00 11 00 01 + r set mykey 1 + assert_encoding int mykey + + assert_equal 0 [r setbit mykey 6 1] + assert_equal [binary format B* 00110011] [r get mykey] + assert_equal 1 [r setbit mykey 2 0] + assert_equal [binary format B* 00010011] [r get mykey] + } + + test "SETBIT against key with wrong type" { + r del mykey + r lpush mykey "foo" + assert_error "WRONGTYPE*" {r setbit mykey 0 1} + } + + test "SETBIT with out of range bit offset" { + r del mykey + assert_error "*out of range*" {r setbit mykey [expr 4*1024*1024*1024] 1} + assert_error "*out of range*" {r setbit mykey -1 1} + } + + test "SETBIT with non-bit argument" { + r del mykey + assert_error "*out of range*" {r setbit mykey 0 -1} + assert_error "*out of range*" {r setbit mykey 0 2} + assert_error "*out of range*" {r setbit mykey 0 10} + assert_error "*out of range*" {r setbit mykey 0 20} + } + + test "SETBIT fuzzing" { + set str "" + set len [expr 256*8] + r del mykey + + for {set i 0} {$i < 2000} {incr i} { + set bitnum [randomInt $len] + set bitval [randomInt 2] + set fmt [format "%%-%ds%%d%%-s" $bitnum] + set head [string range $str 0 $bitnum-1] + set tail [string range $str $bitnum+1 end] + set str [string map {" " 0} [format $fmt $head $bitval $tail]] + + r setbit mykey $bitnum $bitval + assert_equal [binary format B* $str] [r get mykey] + } + } + + test "GETBIT against non-existing key" { + r del mykey + assert_equal 0 [r getbit mykey 0] + } + + test "GETBIT against string-encoded key" { + # Single byte with 2nd and 3rd bit set + r set mykey "`" + + # In-range + assert_equal 0 [r getbit mykey 0] + assert_equal 1 [r getbit mykey 1] + assert_equal 1 [r getbit mykey 2] + assert_equal 0 [r getbit mykey 3] + + # Out-range + assert_equal 0 [r getbit mykey 8] + assert_equal 0 [r getbit mykey 100] + assert_equal 0 [r getbit mykey 10000] + } + + test "GETBIT against integer-encoded key" { + r set mykey 1 + assert_encoding int mykey + + # Ascii "1" is integer 49 = 00 11 00 01 + assert_equal 0 [r getbit mykey 0] + assert_equal 0 [r getbit mykey 1] + assert_equal 1 [r getbit mykey 2] + assert_equal 1 [r getbit mykey 3] + + # Out-range + assert_equal 0 [r getbit mykey 8] + assert_equal 0 [r getbit mykey 100] + assert_equal 0 [r getbit mykey 10000] + } + + test "SETRANGE against non-existing key" { + r del mykey + assert_equal 3 [r setrange mykey 0 foo] + assert_equal "foo" [r get mykey] + + r del mykey + assert_equal 0 [r setrange mykey 0 ""] + assert_equal 0 [r exists mykey] + + r del mykey + assert_equal 4 [r setrange mykey 1 foo] + assert_equal "\000foo" [r get mykey] + } + + test "SETRANGE against string-encoded key" { + r set mykey "foo" + assert_equal 3 [r setrange mykey 0 b] + assert_equal "boo" [r get mykey] + + r set mykey "foo" + assert_equal 3 [r setrange mykey 0 ""] + assert_equal "foo" [r get mykey] + + r set mykey "foo" + assert_equal 3 [r setrange mykey 1 b] + assert_equal "fbo" [r get mykey] + + r set mykey "foo" + assert_equal 7 [r setrange mykey 4 bar] + assert_equal "foo\000bar" [r get mykey] + } + + test "SETRANGE against integer-encoded key" { + r set mykey 1234 + assert_encoding int mykey + assert_equal 4 [r setrange mykey 0 2] + assert_encoding raw mykey + assert_equal 2234 [r get mykey] + + # Shouldn't change encoding when nothing is set + r set mykey 1234 + assert_encoding int mykey + assert_equal 4 [r setrange mykey 0 ""] + assert_encoding int mykey + assert_equal 1234 [r get mykey] + + r set mykey 1234 + assert_encoding int mykey + assert_equal 4 [r setrange mykey 1 3] + assert_encoding raw mykey + assert_equal 1334 [r get mykey] + + r set mykey 1234 + assert_encoding int mykey + assert_equal 6 [r setrange mykey 5 2] + assert_encoding raw mykey + assert_equal "1234\0002" [r get mykey] + } + + test "SETRANGE against key with wrong type" { + r del mykey + r lpush mykey "foo" + assert_error "WRONGTYPE*" {r setrange mykey 0 bar} + } + + test "SETRANGE with out of range offset" { + r del mykey + assert_error "*maximum allowed size*" {r setrange mykey [expr 512*1024*1024-4] world} + + r set mykey "hello" + assert_error "*out of range*" {r setrange mykey -1 world} + assert_error "*maximum allowed size*" {r setrange mykey [expr 512*1024*1024-4] world} + } + + test "GETRANGE against non-existing key" { + r del mykey + assert_equal "" [r getrange mykey 0 -1] + } + + test "GETRANGE against string value" { + r set mykey "Hello World" + assert_equal "Hell" [r getrange mykey 0 3] + assert_equal "Hello World" [r getrange mykey 0 -1] + assert_equal "orld" [r getrange mykey -4 -1] + assert_equal "" [r getrange mykey 5 3] + assert_equal " World" [r getrange mykey 5 5000] + assert_equal "Hello World" [r getrange mykey -5000 10000] + } + + test "GETRANGE against integer-encoded value" { + r set mykey 1234 + assert_equal "123" [r getrange mykey 0 2] + assert_equal "1234" [r getrange mykey 0 -1] + assert_equal "234" [r getrange mykey -3 -1] + assert_equal "" [r getrange mykey 5 3] + assert_equal "4" [r getrange mykey 3 5000] + assert_equal "1234" [r getrange mykey -5000 10000] + } + + test "GETRANGE fuzzing" { + for {set i 0} {$i < 1000} {incr i} { + r set bin [set bin [randstring 0 1024 binary]] + set _start [set start [randomInt 1500]] + set _end [set end [randomInt 1500]] + if {$_start < 0} {set _start "end-[abs($_start)-1]"} + if {$_end < 0} {set _end "end-[abs($_end)-1]"} + assert_equal [string range $bin $_start $_end] [r getrange bin $start $end] + } + } + + test {Extended SET can detect syntax errors} { + set e {} + catch {r set foo bar non-existing-option} e + set e + } {*syntax*} + + test {Extended SET NX option} { + r del foo + set v1 [r set foo 1 nx] + set v2 [r set foo 2 nx] + list $v1 $v2 [r get foo] + } {OK {} 1} + + test {Extended SET XX option} { + r del foo + set v1 [r set foo 1 xx] + r set foo bar + set v2 [r set foo 2 xx] + list $v1 $v2 [r get foo] + } {{} OK 2} + + test {Extended SET EX option} { + r del foo + r set foo bar ex 10 + set ttl [r ttl foo] + assert {$ttl <= 10 && $ttl > 5} + } + + test {Extended SET PX option} { + r del foo + r set foo bar px 10000 + set ttl [r ttl foo] + assert {$ttl <= 10 && $ttl > 5} + } + + test {Extended SET using multiple options at once} { + r set foo val + assert {[r set foo bar xx px 10000] eq {OK}} + set ttl [r ttl foo] + assert {$ttl <= 10 && $ttl > 5} + } + + test {KEYS * two times with long key, Github issue #1208} { + r flushdb + r set dlskeriewrioeuwqoirueioqwrueoqwrueqw test + r keys * + r keys * + } {dlskeriewrioeuwqoirueioqwrueoqwrueqw} + + test {GETRANGE with huge ranges, Github issue #1844} { + r set foo bar + r getrange foo 0 4294967297 + } {bar} +} diff --git a/pikatests/tests/unit/bitops.tcl b/pikatests/tests/unit/bitops.tcl new file mode 100644 index 0000000000..9751850ad4 --- /dev/null +++ b/pikatests/tests/unit/bitops.tcl @@ -0,0 +1,341 @@ +# Compare Redis commadns against Tcl implementations of the same commands. +proc count_bits s { + binary scan $s b* bits + string length [regsub -all {0} $bits {}] +} + +proc simulate_bit_op {op args} { + set maxlen 0 + set j 0 + set count [llength $args] + foreach a $args { + binary scan $a b* bits + set b($j) $bits + if {[string length $bits] > $maxlen} { + set maxlen [string length $bits] + } + incr j + } + for {set j 0} {$j < $count} {incr j} { + if {[string length $b($j)] < $maxlen} { + append b($j) [string repeat 0 [expr $maxlen-[string length $b($j)]]] + } + } + set out {} + for {set x 0} {$x < $maxlen} {incr x} { + set bit [string range $b(0) $x $x] + if {$op eq {not}} {set bit [expr {!$bit}]} + for {set j 1} {$j < $count} {incr j} { + set bit2 [string range $b($j) $x $x] + switch $op { + and {set bit [expr {$bit & $bit2}]} + or {set bit [expr {$bit | $bit2}]} + xor {set bit [expr {$bit ^ $bit2}]} + } + } + append out $bit + } + binary format b* $out +} + +start_server {tags {"bitops"}} { + test {BITCOUNT returns 0 against non existing key} { + r bitcount no-key + } 0 + + catch {unset num} + foreach vec [list "" "\xaa" "\x00\x00\xff" "foobar" "123"] { + incr num + test "BITCOUNT against test vector #$num" { + r set str $vec + assert {[r bitcount str] == [count_bits $vec]} + } + } + + test {BITCOUNT fuzzing without start/end} { + for {set j 0} {$j < 100} {incr j} { + set str [randstring 0 3000] + r set str $str + assert {[r bitcount str] == [count_bits $str]} + } + } + + test {BITCOUNT fuzzing with start/end} { + for {set j 0} {$j < 100} {incr j} { + set str [randstring 0 3000] + r set str $str + set l [string length $str] + set start [randomInt $l] + set end [randomInt $l] + if {$start > $end} { + lassign [list $end $start] start end + } + assert {[r bitcount str $start $end] == [count_bits [string range $str $start $end]]} + } + } + + test {BITCOUNT with start, end} { + r set s "foobar" + assert_equal [r bitcount s 0 -1] [count_bits "foobar"] + assert_equal [r bitcount s 1 -2] [count_bits "ooba"] + assert_equal [r bitcount s -2 1] [count_bits ""] + assert_equal [r bitcount s 0 1000] [count_bits "foobar"] + } + + test {BITCOUNT syntax error #1} { + catch {r bitcount s 0} e + set e + } {ERR*syntax*} + + test {BITCOUNT regression test for github issue #582} { + r del str + r setbit foo 0 1 + if {[catch {r bitcount foo 0 4294967296} e]} { + assert_match {*ERR*out of range*} $e + set _ 1 + } else { + set e + } + } {1} + + test {BITCOUNT misaligned prefix} { + r del str + r set str ab + r bitcount str 1 -1 + } {3} + + test {BITCOUNT misaligned prefix + full words + remainder} { + r del str + r set str __PPxxxxxxxxxxxxxxxxRR__ + r bitcount str 2 -3 + } {74} + + test {BITOP NOT (empty string)} { + r set s "" + r bitop not dest s + r get dest + } {} + + test {BITOP NOT (known string)} { + r set s "\xaa\x00\xff\x55" + r bitop not dest s + r get dest + } "\x55\xff\x00\xaa" + + test {BITOP where dest and target are the same key} { + r set s "\xaa\x00\xff\x55" + r bitop not s s + r get s + } "\x55\xff\x00\xaa" + + test {BITOP AND|OR|XOR don't change the string with single input key} { + r set a "\x01\x02\xff" + r bitop and res1 a + r bitop or res2 a + r bitop xor res3 a + list [r get res1] [r get res2] [r get res3] + } [list "\x01\x02\xff" "\x01\x02\xff" "\x01\x02\xff"] + + test {BITOP missing key is considered a stream of zero} { + r set a "\x01\x02\xff" + r bitop and res1 no-suck-key a + r bitop or res2 no-suck-key a no-such-key + r bitop xor res3 no-such-key a + list [r get res1] [r get res2] [r get res3] + } [list "\x00\x00\x00" "\x01\x02\xff" "\x01\x02\xff"] + + test {BITOP shorter keys are zero-padded to the key with max length} { + r set a "\x01\x02\xff\xff" + r set b "\x01\x02\xff" + r bitop and res1 a b + r bitop or res2 a b + r bitop xor res3 a b + list [r get res1] [r get res2] [r get res3] + } [list "\x01\x02\xff\x00" "\x01\x02\xff\xff" "\x00\x00\x00\xff"] + + foreach op {and or xor} { + test "BITOP $op fuzzing" { + for {set i 0} {$i < 10} {incr i} { + r flushall + set vec {} + set veckeys {} + set numvec [expr {[randomInt 10]+1}] + for {set j 0} {$j < $numvec} {incr j} { + set str [randstring 0 1000] + lappend vec $str + lappend veckeys vector_$j + r set vector_$j $str + } + r bitop $op target {*}$veckeys + assert_equal [r get target] [simulate_bit_op $op {*}$vec] + } + } + } + + test {BITOP NOT fuzzing} { + for {set i 0} {$i < 10} {incr i} { + r flushall + set str [randstring 0 1000] + r set str $str + r bitop not target str + assert_equal [r get target] [simulate_bit_op not $str] + } + } + + test {BITOP with integer encoded source objects} { + r set a 1 + r set b 2 + r bitop xor dest a b a + r get dest + } {2} + + test {BITOP with non string source key} { + r del c + r set a 1 + r set b 2 + r lpush c foo + catch {r bitop xor dest a b c d} e + set e + } {WRONGTYPE*} + + test {BITOP with empty string after non empty string (issue #529)} { + r flushdb + r set a "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + r bitop or x a b + } {32} + + test {BITPOS bit=0 with empty key returns 0} { + r del str + r bitpos str 0 + } {0} + + test {BITPOS bit=1 with empty key returns -1} { + r del str + r bitpos str 1 + } {-1} + + test {BITPOS bit=0 with string less than 1 word works} { + r set str "\xff\xf0\x00" + r bitpos str 0 + } {12} + + test {BITPOS bit=1 with string less than 1 word works} { + r set str "\x00\x0f\x00" + r bitpos str 1 + } {12} + + test {BITPOS bit=0 starting at unaligned address} { + r set str "\xff\xf0\x00" + r bitpos str 0 1 + } {12} + + test {BITPOS bit=1 starting at unaligned address} { + r set str "\x00\x0f\xff" + r bitpos str 1 1 + } {12} + + test {BITPOS bit=0 unaligned+full word+reminder} { + r del str + r set str "\xff\xff\xff" ; # Prefix + # Followed by two (or four in 32 bit systems) full words + r append str "\xff\xff\xff\xff\xff\xff\xff\xff" + r append str "\xff\xff\xff\xff\xff\xff\xff\xff" + r append str "\xff\xff\xff\xff\xff\xff\xff\xff" + # First zero bit. + r append str "\x0f" + assert {[r bitpos str 0] == 216} + assert {[r bitpos str 0 1] == 216} + assert {[r bitpos str 0 2] == 216} + assert {[r bitpos str 0 3] == 216} + assert {[r bitpos str 0 4] == 216} + assert {[r bitpos str 0 5] == 216} + assert {[r bitpos str 0 6] == 216} + assert {[r bitpos str 0 7] == 216} + assert {[r bitpos str 0 8] == 216} + } + + test {BITPOS bit=1 unaligned+full word+reminder} { + r del str + r set str "\x00\x00\x00" ; # Prefix + # Followed by two (or four in 32 bit systems) full words + r append str "\x00\x00\x00\x00\x00\x00\x00\x00" + r append str "\x00\x00\x00\x00\x00\x00\x00\x00" + r append str "\x00\x00\x00\x00\x00\x00\x00\x00" + # First zero bit. + r append str "\xf0" + assert {[r bitpos str 1] == 216} + assert {[r bitpos str 1 1] == 216} + assert {[r bitpos str 1 2] == 216} + assert {[r bitpos str 1 3] == 216} + assert {[r bitpos str 1 4] == 216} + assert {[r bitpos str 1 5] == 216} + assert {[r bitpos str 1 6] == 216} + assert {[r bitpos str 1 7] == 216} + assert {[r bitpos str 1 8] == 216} + } + + test {BITPOS bit=1 returns -1 if string is all 0 bits} { + r set str "" + for {set j 0} {$j < 20} {incr j} { + assert {[r bitpos str 1] == -1} + r append str "\x00" + } + } + + test {BITPOS bit=0 works with intervals} { + r set str "\x00\xff\x00" + assert {[r bitpos str 0 0 -1] == 0} + assert {[r bitpos str 0 1 -1] == 16} + assert {[r bitpos str 0 2 -1] == 16} + assert {[r bitpos str 0 2 200] == 16} + assert {[r bitpos str 0 1 1] == -1} + } + + test {BITPOS bit=1 works with intervals} { + r set str "\x00\xff\x00" + assert {[r bitpos str 1 0 -1] == 8} + assert {[r bitpos str 1 1 -1] == 8} + assert {[r bitpos str 1 2 -1] == -1} + assert {[r bitpos str 1 2 200] == -1} + assert {[r bitpos str 1 1 1] == 8} + } + + test {BITPOS bit=0 changes behavior if end is given} { + r set str "\xff\xff\xff" + assert {[r bitpos str 0] == 24} + assert {[r bitpos str 0 0] == 24} + assert {[r bitpos str 0 0 -1] == -1} + } + + test {BITPOS bit=1 fuzzy testing using SETBIT} { + r del str + set max 524288; # 64k + set first_one_pos -1 + for {set j 0} {$j < 1000} {incr j} { + assert {[r bitpos str 1] == $first_one_pos} + set pos [randomInt $max] + r setbit str $pos 1 + if {$first_one_pos == -1 || $first_one_pos > $pos} { + # Update the position of the first 1 bit in the array + # if the bit we set is on the left of the previous one. + set first_one_pos $pos + } + } + } + + test {BITPOS bit=0 fuzzy testing using SETBIT} { + set max 524288; # 64k + set first_zero_pos $max + r set str [string repeat "\xff" [expr $max/8]] + for {set j 0} {$j < 1000} {incr j} { + assert {[r bitpos str 0] == $first_zero_pos} + set pos [randomInt $max] + r setbit str $pos 0 + if {$first_zero_pos > $pos} { + # Update the position of the first 0 bit in the array + # if the bit we clear is on the left of the previous one. + set first_zero_pos $pos + } + } + } +} diff --git a/pikatests/tests/unit/dump.tcl b/pikatests/tests/unit/dump.tcl new file mode 100644 index 0000000000..b79c3ba9d0 --- /dev/null +++ b/pikatests/tests/unit/dump.tcl @@ -0,0 +1,142 @@ +start_server {tags {"dump"}} { + test {DUMP / RESTORE are able to serialize / unserialize a simple key} { + r set foo bar + set encoded [r dump foo] + r del foo + list [r exists foo] [r restore foo 0 $encoded] [r ttl foo] [r get foo] + } {0 OK -1 bar} + + test {RESTORE can set an arbitrary expire to the materialized key} { + r set foo bar + set encoded [r dump foo] + r del foo + r restore foo 5000 $encoded + set ttl [r pttl foo] + assert {$ttl >= 3000 && $ttl <= 5000} + r get foo + } {bar} + + test {RESTORE can set an expire that overflows a 32 bit integer} { + r set foo bar + set encoded [r dump foo] + r del foo + r restore foo 2569591501 $encoded + set ttl [r pttl foo] + assert {$ttl >= (2569591501-3000) && $ttl <= 2569591501} + r get foo + } {bar} + + test {RESTORE returns an error of the key already exists} { + r set foo bar + set e {} + catch {r restore foo 0 "..."} e + set e + } {*is busy*} + + test {DUMP of non existing key returns nil} { + r dump nonexisting_key + } {} + + test {MIGRATE is able to migrate a key between two instances} { + set first [srv 0 client] + r set key "Some Value" + start_server {tags {"repl"}} { + set second [srv 0 client] + set second_host [srv 0 host] + set second_port [srv 0 port] + + assert {[$first exists key] == 1} + assert {[$second exists key] == 0} + set ret [r -1 migrate $second_host $second_port key 9 5000] + assert {$ret eq {OK}} + assert {[$first exists key] == 0} + assert {[$second exists key] == 1} + assert {[$second get key] eq {Some Value}} + assert {[$second ttl key] == -1} + } + } + + test {MIGRATE propagates TTL correctly} { + set first [srv 0 client] + r set key "Some Value" + start_server {tags {"repl"}} { + set second [srv 0 client] + set second_host [srv 0 host] + set second_port [srv 0 port] + + assert {[$first exists key] == 1} + assert {[$second exists key] == 0} + $first expire key 10 + set ret [r -1 migrate $second_host $second_port key 9 5000] + assert {$ret eq {OK}} + assert {[$first exists key] == 0} + assert {[$second exists key] == 1} + assert {[$second get key] eq {Some Value}} + assert {[$second ttl key] >= 7 && [$second ttl key] <= 10} + } + } + + test {MIGRATE can correctly transfer large values} { + set first [srv 0 client] + r del key + for {set j 0} {$j < 5000} {incr j} { + r rpush key 1 2 3 4 5 6 7 8 9 10 + r rpush key "item 1" "item 2" "item 3" "item 4" "item 5" \ + "item 6" "item 7" "item 8" "item 9" "item 10" + } + assert {[string length [r dump key]] > (1024*64)} + start_server {tags {"repl"}} { + set second [srv 0 client] + set second_host [srv 0 host] + set second_port [srv 0 port] + + assert {[$first exists key] == 1} + assert {[$second exists key] == 0} + set ret [r -1 migrate $second_host $second_port key 9 10000] + assert {$ret eq {OK}} + assert {[$first exists key] == 0} + assert {[$second exists key] == 1} + assert {[$second ttl key] == -1} + assert {[$second llen key] == 5000*20} + } + } + + test {MIGRATE can correctly transfer hashes} { + set first [srv 0 client] + r del key + r hmset key field1 "item 1" field2 "item 2" field3 "item 3" \ + field4 "item 4" field5 "item 5" field6 "item 6" + start_server {tags {"repl"}} { + set second [srv 0 client] + set second_host [srv 0 host] + set second_port [srv 0 port] + + assert {[$first exists key] == 1} + assert {[$second exists key] == 0} + set ret [r -1 migrate $second_host $second_port key 9 10000] + assert {$ret eq {OK}} + assert {[$first exists key] == 0} + assert {[$second exists key] == 1} + assert {[$second ttl key] == -1} + } + } + + test {MIGRATE timeout actually works} { + set first [srv 0 client] + r set key "Some Value" + start_server {tags {"repl"}} { + set second [srv 0 client] + set second_host [srv 0 host] + set second_port [srv 0 port] + + assert {[$first exists key] == 1} + assert {[$second exists key] == 0} + + set rd [redis_deferring_client] + $rd debug sleep 5.0 ; # Make second server unable to reply. + set e {} + catch {r -1 migrate $second_host $second_port key 9 1000} e + assert_match {IOERR*} $e + } + } +} diff --git a/pikatests/tests/unit/expire.tcl b/pikatests/tests/unit/expire.tcl new file mode 100644 index 0000000000..ff3dacb337 --- /dev/null +++ b/pikatests/tests/unit/expire.tcl @@ -0,0 +1,201 @@ +start_server {tags {"expire"}} { + test {EXPIRE - set timeouts multiple times} { + r set x foobar + set v1 [r expire x 5] + set v2 [r ttl x] + set v3 [r expire x 10] + set v4 [r ttl x] + r expire x 2 + list $v1 $v2 $v3 $v4 + } {1 [45] 1 10} + + test {EXPIRE - It should be still possible to read 'x'} { + r get x + } {foobar} + + tags {"slow"} { + test {EXPIRE - After 2.1 seconds the key should no longer be here} { + after 2100 + list [r get x] [r exists x] + } {{} 0} + } + + test {EXPIRE - write on expire should work} { + r del x + r lpush x foo + r expire x 1000 + r lpush x bar + r lrange x 0 -1 + } {bar foo} + + test {EXPIREAT - Check for EXPIRE alike behavior} { + r del x + r set x foo + r expireat x [expr [clock seconds]+15] + r ttl x + } {1[345]} + + test {SETEX - Set + Expire combo operation. Check for TTL} { + r setex x 12 test + r ttl x + } {1[012]} + + test {SETEX - Check value} { + r get x + } {test} + + test {SETEX - Overwrite old key} { + r setex y 1 foo + r get y + } {foo} + + tags {"slow"} { + test {SETEX - Wait for the key to expire} { + after 1100 + r get y + } {} + } + + test {SETEX - Wrong time parameter} { + catch {r setex z -10 foo} e + set _ $e + } {*invalid expire*} + + test {PERSIST can undo an EXPIRE} { + r set x foo + r expire x 50 + list [r ttl x] [r persist x] [r ttl x] [r get x] + } {50 1 -1 foo} + + test {PERSIST returns 0 against non existing or non volatile keys} { + r set x foo + list [r persist foo] [r persist nokeyatall] + } {0 0} + + test {EXPIRE pricision is now the millisecond} { + # This test is very likely to do a false positive if the + # server is under pressure, so if it does not work give it a few more + # chances. + for {set j 0} {$j < 3} {incr j} { + r del x + r setex x 1 somevalue + after 900 + set a [r get x] + after 1100 + set b [r get x] + if {$a eq {somevalue} && $b eq {}} break + } + list $a $b + } {somevalue {}} + + test {PEXPIRE/PSETEX/PEXPIREAT can set sub-second expires} { + # This test is very likely to do a false positive if the + # server is under pressure, so if it does not work give it a few more + # chances. + for {set j 0} {$j < 3} {incr j} { + r del x y z + r psetex x 100 somevalue + after 80 + set a [r get x] + after 120 + set b [r get x] + + r set x somevalue + r pexpire x 100 + after 80 + set c [r get x] + after 120 + set d [r get x] + + r set x somevalue + r pexpireat x [expr ([clock seconds]*1000)+100] + after 80 + set e [r get x] + after 120 + set f [r get x] + + if {$a eq {somevalue} && $b eq {} && + $c eq {somevalue} && $d eq {} && + $e eq {somevalue} && $f eq {}} break + } + list $a $b + } {somevalue {}} + + test {TTL returns tiem to live in seconds} { + r del x + r setex x 10 somevalue + set ttl [r ttl x] + assert {$ttl > 8 && $ttl <= 10} + } + + test {PTTL returns time to live in milliseconds} { + r del x + r setex x 1 somevalue + set ttl [r pttl x] + assert {$ttl > 900 && $ttl <= 1000} + } + + test {TTL / PTTL return -1 if key has no expire} { + r del x + r set x hello + list [r ttl x] [r pttl x] + } {-1 -1} + + test {TTL / PTTL return -2 if key does not exit} { + r del x + list [r ttl x] [r pttl x] + } {-2 -2} + + test {Redis should actively expire keys incrementally} { + r flushdb + r psetex key1 500 a + r psetex key2 500 a + r psetex key3 500 a + set size1 [r dbsize] + # Redis expires random keys ten times every second so we are + # fairly sure that all the three keys should be evicted after + # one second. + after 1000 + set size2 [r dbsize] + list $size1 $size2 + } {3 0} + + test {Redis should lazy expire keys} { + r flushdb + r debug set-active-expire 0 + r psetex key1 500 a + r psetex key2 500 a + r psetex key3 500 a + set size1 [r dbsize] + # Redis expires random keys ten times every second so we are + # fairly sure that all the three keys should be evicted after + # one second. + after 1000 + set size2 [r dbsize] + r mget key1 key2 key3 + set size3 [r dbsize] + r debug set-active-expire 1 + list $size1 $size2 $size3 + } {3 3 0} + + test {EXPIRE should not resurrect keys (issue #1026)} { + r debug set-active-expire 0 + r set foo bar + r pexpire foo 500 + after 1000 + r expire foo 10 + r debug set-active-expire 1 + r exists foo + } {0} + + test {5 keys in, 5 keys out} { + r flushdb + r set a c + r expire a 5 + r set t c + r set e c + r set s c + r set foo b + lsort [r keys *] + } {a e foo s t} +} diff --git a/pikatests/tests/unit/hyperloglog.tcl b/pikatests/tests/unit/hyperloglog.tcl new file mode 100644 index 0000000000..3f51420760 --- /dev/null +++ b/pikatests/tests/unit/hyperloglog.tcl @@ -0,0 +1,170 @@ +start_server {tags {"hll"}} { + test {HyperLogLog self test passes} { + catch {r pfselftest} e + set e + } {OK} + + test {PFADD without arguments creates an HLL value} { + r pfadd hll + r exists hll + } {1} + + test {Approximated cardinality after creation is zero} { + r pfcount hll + } {0} + + test {PFADD returns 1 when at least 1 reg was modified} { + r pfadd hll a b c + } {1} + + test {PFADD returns 0 when no reg was modified} { + r pfadd hll a b c + } {0} + + test {PFADD works with empty string (regression)} { + r pfadd hll "" + } + + # Note that the self test stresses much better the + # cardinality estimation error. We are testing just the + # command implementation itself here. + test {PFCOUNT returns approximated cardinality of set} { + r del hll + set res {} + r pfadd hll 1 2 3 4 5 + lappend res [r pfcount hll] + # Call it again to test cached value invalidation. + r pfadd hll 6 7 8 8 9 10 + lappend res [r pfcount hll] + set res + } {5 10} + + test {HyperLogLogs are promote from sparse to dense} { + r del hll + r config set hll-sparse-max-bytes 3000 + set n 0 + while {$n < 100000} { + set elements {} + for {set j 0} {$j < 100} {incr j} {lappend elements [expr rand()]} + incr n 100 + r pfadd hll {*}$elements + set card [r pfcount hll] + set err [expr {abs($card-$n)}] + assert {$err < (double($card)/100)*5} + if {$n < 1000} { + assert {[r pfdebug encoding hll] eq {sparse}} + } elseif {$n > 10000} { + assert {[r pfdebug encoding hll] eq {dense}} + } + } + } + + test {HyperLogLog sparse encoding stress test} { + for {set x 0} {$x < 1000} {incr x} { + r del hll1 hll2 + set numele [randomInt 100] + set elements {} + for {set j 0} {$j < $numele} {incr j} { + lappend elements [expr rand()] + } + # Force dense representation of hll2 + r pfadd hll2 + r pfdebug todense hll2 + r pfadd hll1 {*}$elements + r pfadd hll2 {*}$elements + assert {[r pfdebug encoding hll1] eq {sparse}} + assert {[r pfdebug encoding hll2] eq {dense}} + # Cardinality estimated should match exactly. + assert {[r pfcount hll1] eq [r pfcount hll2]} + } + } + + test {Corrupted sparse HyperLogLogs are detected: Additionl at tail} { + r del hll + r pfadd hll a b c + r append hll "hello" + set e {} + catch {r pfcount hll} e + set e + } {*INVALIDOBJ*} + + test {Corrupted sparse HyperLogLogs are detected: Broken magic} { + r del hll + r pfadd hll a b c + r setrange hll 0 "0123" + set e {} + catch {r pfcount hll} e + set e + } {*WRONGTYPE*} + + test {Corrupted sparse HyperLogLogs are detected: Invalid encoding} { + r del hll + r pfadd hll a b c + r setrange hll 4 "x" + set e {} + catch {r pfcount hll} e + set e + } {*WRONGTYPE*} + + test {Corrupted dense HyperLogLogs are detected: Wrong length} { + r del hll + r pfadd hll a b c + r setrange hll 4 "\x00" + set e {} + catch {r pfcount hll} e + set e + } {*WRONGTYPE*} + + test {PFADD, PFCOUNT, PFMERGE type checking works} { + r set foo bar + catch {r pfadd foo 1} e + assert_match {*WRONGTYPE*} $e + catch {r pfcount foo} e + assert_match {*WRONGTYPE*} $e + catch {r pfmerge bar foo} e + assert_match {*WRONGTYPE*} $e + catch {r pfmerge foo bar} e + assert_match {*WRONGTYPE*} $e + } + + test {PFMERGE results on the cardinality of union of sets} { + r del hll hll1 hll2 hll3 + r pfadd hll1 a b c + r pfadd hll2 b c d + r pfadd hll3 c d e + r pfmerge hll hll1 hll2 hll3 + r pfcount hll + } {5} + + test {PFCOUNT multiple-keys merge returns cardinality of union} { + r del hll1 hll2 hll3 + for {set x 1} {$x < 10000} {incr x} { + # Force dense representation of hll2 + r pfadd hll1 "foo-$x" + r pfadd hll2 "bar-$x" + r pfadd hll3 "zap-$x" + + set card [r pfcount hll1 hll2 hll3] + set realcard [expr {$x*3}] + set err [expr {abs($card-$realcard)}] + assert {$err < (double($card)/100)*5} + } + } + + test {PFDEBUG GETREG returns the HyperLogLog raw registers} { + r del hll + r pfadd hll 1 2 3 + llength [r pfdebug getreg hll] + } {16384} + + test {PFADD / PFCOUNT cache invalidation works} { + r del hll + r pfadd hll a b c + r pfcount hll + assert {[r getrange hll 15 15] eq "\x00"} + r pfadd hll a b c + assert {[r getrange hll 15 15] eq "\x00"} + r pfadd hll 1 2 3 + assert {[r getrange hll 15 15] eq "\x80"} + } +} diff --git a/pikatests/tests/unit/introspection.tcl b/pikatests/tests/unit/introspection.tcl new file mode 100644 index 0000000000..342bb939a8 --- /dev/null +++ b/pikatests/tests/unit/introspection.tcl @@ -0,0 +1,59 @@ +start_server {tags {"introspection"}} { + test {CLIENT LIST} { + r client list + } {*addr=*:* fd=* age=* idle=* flags=N db=9 sub=0 psub=0 multi=-1 qbuf=0 qbuf-free=* obl=0 oll=0 omem=0 events=r cmd=client*} + + test {MONITOR can log executed commands} { + set rd [redis_deferring_client] + $rd monitor + r set foo bar + r get foo + list [$rd read] [$rd read] [$rd read] + } {*OK*"set" "foo"*"get" "foo"*} + + test {MONITOR can log commands issued by the scripting engine} { + set rd [redis_deferring_client] + $rd monitor + r eval {redis.call('set',KEYS[1],ARGV[1])} 1 foo bar + $rd read ;# Discard the OK + assert_match {*eval*} [$rd read] + assert_match {*lua*"set"*"foo"*"bar"*} [$rd read] + } + + test {CLIENT GETNAME should return NIL if name is not assigned} { + r client getname + } {} + + test {CLIENT LIST shows empty fields for unassigned names} { + r client list + } {*name= *} + + test {CLIENT SETNAME does not accept spaces} { + catch {r client setname "foo bar"} e + set e + } {ERR*} + + test {CLIENT SETNAME can assign a name to this connection} { + assert_equal [r client setname myname] {OK} + r client list + } {*name=myname*} + + test {CLIENT SETNAME can change the name of an existing connection} { + assert_equal [r client setname someothername] {OK} + r client list + } {*name=someothername*} + + test {After CLIENT SETNAME, connection can still be closed} { + set rd [redis_deferring_client] + $rd client setname foobar + assert_equal [$rd read] "OK" + assert_match {*foobar*} [r client list] + $rd close + # Now the client should no longer be listed + wait_for_condition 50 100 { + [string match {*foobar*} [r client list]] == 0 + } else { + fail "Client still listed in CLIENT LIST after SETNAME." + } + } +} diff --git a/pikatests/tests/unit/latency-monitor.tcl b/pikatests/tests/unit/latency-monitor.tcl new file mode 100644 index 0000000000..b736cad98b --- /dev/null +++ b/pikatests/tests/unit/latency-monitor.tcl @@ -0,0 +1,50 @@ +start_server {tags {"latency-monitor"}} { + # Set a threshold high enough to avoid spurious latency events. + r config set latency-monitor-threshold 200 + r latency reset + + test {Test latency events logging} { + r debug sleep 0.3 + after 1100 + r debug sleep 0.4 + after 1100 + r debug sleep 0.5 + assert {[r latency history command] >= 3} + } + + test {LATENCY HISTORY output is ok} { + set min 250 + set max 450 + foreach event [r latency history command] { + lassign $event time latency + assert {$latency >= $min && $latency <= $max} + incr min 100 + incr max 100 + set last_time $time ; # Used in the next test + } + } + + test {LATENCY LATEST output is ok} { + foreach event [r latency latest] { + lassign $event eventname time latency max + assert {$eventname eq "command"} + assert {$max >= 450 & $max <= 650} + assert {$time == $last_time} + break + } + } + + test {LATENCY HISTORY / RESET with wrong event name is fine} { + assert {[llength [r latency history blabla]] == 0} + assert {[r latency reset blabla] == 0} + } + + test {LATENCY DOCTOR produces some output} { + assert {[string length [r latency doctor]] > 0} + } + + test {LATENCY RESET is able to reset events} { + assert {[r latency reset] > 0} + assert {[r latency latest] eq {}} + } +} diff --git a/pikatests/tests/unit/limits.tcl b/pikatests/tests/unit/limits.tcl new file mode 100644 index 0000000000..b37ea9b0f5 --- /dev/null +++ b/pikatests/tests/unit/limits.tcl @@ -0,0 +1,16 @@ +start_server {tags {"limits"} overrides {maxclients 10}} { + test {Check if maxclients works refusing connections} { + set c 0 + catch { + while {$c < 50} { + incr c + set rd [redis_deferring_client] + $rd ping + $rd read + after 100 + } + } e + assert {$c > 8 && $c <= 10} + set e + } {*ERR max*reached*} +} diff --git a/pikatests/tests/unit/maxmemory.tcl b/pikatests/tests/unit/maxmemory.tcl new file mode 100644 index 0000000000..e6bf7860cb --- /dev/null +++ b/pikatests/tests/unit/maxmemory.tcl @@ -0,0 +1,144 @@ +start_server {tags {"maxmemory"}} { + test "Without maxmemory small integers are shared" { + r config set maxmemory 0 + r set a 1 + assert {[r object refcount a] > 1} + } + + test "With maxmemory and non-LRU policy integers are still shared" { + r config set maxmemory 1073741824 + r config set maxmemory-policy allkeys-random + r set a 1 + assert {[r object refcount a] > 1} + } + + test "With maxmemory and LRU policy integers are not shared" { + r config set maxmemory 1073741824 + r config set maxmemory-policy allkeys-lru + r set a 1 + r config set maxmemory-policy volatile-lru + r set b 1 + assert {[r object refcount a] == 1} + assert {[r object refcount b] == 1} + r config set maxmemory 0 + } + + foreach policy { + allkeys-random allkeys-lru volatile-lru volatile-random volatile-ttl + } { + test "maxmemory - is the memory limit honoured? (policy $policy)" { + # make sure to start with a blank instance + r flushall + # Get the current memory limit and calculate a new limit. + # We just add 100k to the current memory size so that it is + # fast for us to reach that limit. + set used [s used_memory] + set limit [expr {$used+100*1024}] + r config set maxmemory $limit + r config set maxmemory-policy $policy + # Now add keys until the limit is almost reached. + set numkeys 0 + while 1 { + r setex [randomKey] 10000 x + incr numkeys + if {[s used_memory]+4096 > $limit} { + assert {$numkeys > 10} + break + } + } + # If we add the same number of keys already added again, we + # should still be under the limit. + for {set j 0} {$j < $numkeys} {incr j} { + r setex [randomKey] 10000 x + } + assert {[s used_memory] < ($limit+4096)} + } + } + + foreach policy { + allkeys-random allkeys-lru volatile-lru volatile-random volatile-ttl + } { + test "maxmemory - only allkeys-* should remove non-volatile keys ($policy)" { + # make sure to start with a blank instance + r flushall + # Get the current memory limit and calculate a new limit. + # We just add 100k to the current memory size so that it is + # fast for us to reach that limit. + set used [s used_memory] + set limit [expr {$used+100*1024}] + r config set maxmemory $limit + r config set maxmemory-policy $policy + # Now add keys until the limit is almost reached. + set numkeys 0 + while 1 { + r set [randomKey] x + incr numkeys + if {[s used_memory]+4096 > $limit} { + assert {$numkeys > 10} + break + } + } + # If we add the same number of keys already added again and + # the policy is allkeys-* we should still be under the limit. + # Otherwise we should see an error reported by Redis. + set err 0 + for {set j 0} {$j < $numkeys} {incr j} { + if {[catch {r set [randomKey] x} e]} { + if {[string match {*used memory*} $e]} { + set err 1 + } + } + } + if {[string match allkeys-* $policy]} { + assert {[s used_memory] < ($limit+4096)} + } else { + assert {$err == 1} + } + } + } + + foreach policy { + volatile-lru volatile-random volatile-ttl + } { + test "maxmemory - policy $policy should only remove volatile keys." { + # make sure to start with a blank instance + r flushall + # Get the current memory limit and calculate a new limit. + # We just add 100k to the current memory size so that it is + # fast for us to reach that limit. + set used [s used_memory] + set limit [expr {$used+100*1024}] + r config set maxmemory $limit + r config set maxmemory-policy $policy + # Now add keys until the limit is almost reached. + set numkeys 0 + while 1 { + # Odd keys are volatile + # Even keys are non volatile + if {$numkeys % 2} { + r setex "key:$numkeys" 10000 x + } else { + r set "key:$numkeys" x + } + if {[s used_memory]+4096 > $limit} { + assert {$numkeys > 10} + break + } + incr numkeys + } + # Now we add the same number of volatile keys already added. + # We expect Redis to evict only volatile keys in order to make + # space. + set err 0 + for {set j 0} {$j < $numkeys} {incr j} { + catch {r setex "foo:$j" 10000 x} + } + # We should still be under the limit. + assert {[s used_memory] < ($limit+4096)} + # However all our non volatile keys should be here. + for {set j 0} {$j < $numkeys} {incr j 2} { + assert {[r exists "key:$j"]} + } + } + } +} diff --git a/pikatests/tests/unit/memefficiency.tcl b/pikatests/tests/unit/memefficiency.tcl new file mode 100644 index 0000000000..7ca9a705bb --- /dev/null +++ b/pikatests/tests/unit/memefficiency.tcl @@ -0,0 +1,37 @@ +proc test_memory_efficiency {range} { + r flushall + set rd [redis_deferring_client] + set base_mem [s used_memory] + set written 0 + for {set j 0} {$j < 10000} {incr j} { + set key key:$j + set val [string repeat A [expr {int(rand()*$range)}]] + $rd set $key $val + incr written [string length $key] + incr written [string length $val] + incr written 2 ;# A separator is the minimum to store key-value data. + } + for {set j 0} {$j < 10000} {incr j} { + $rd read ; # Discard replies + } + + set current_mem [s used_memory] + set used [expr {$current_mem-$base_mem}] + set efficiency [expr {double($written)/$used}] + return $efficiency +} + +start_server {tags {"memefficiency"}} { + foreach {size_range expected_min_efficiency} { + 32 0.15 + 64 0.25 + 128 0.35 + 1024 0.75 + 16384 0.82 + } { + test "Memory efficiency with values in range $size_range" { + set efficiency [test_memory_efficiency $size_range] + assert {$efficiency >= $expected_min_efficiency} + } + } +} diff --git a/pikatests/tests/unit/multi.tcl b/pikatests/tests/unit/multi.tcl new file mode 100644 index 0000000000..6655bf62c2 --- /dev/null +++ b/pikatests/tests/unit/multi.tcl @@ -0,0 +1,309 @@ +start_server {tags {"multi"}} { + test {MUTLI / EXEC basics} { + r del mylist + r rpush mylist a + r rpush mylist b + r rpush mylist c + r multi + set v1 [r lrange mylist 0 -1] + set v2 [r ping] + set v3 [r exec] + list $v1 $v2 $v3 + } {QUEUED QUEUED {{a b c} PONG}} + + test {DISCARD} { + r del mylist + r rpush mylist a + r rpush mylist b + r rpush mylist c + r multi + set v1 [r del mylist] + set v2 [r discard] + set v3 [r lrange mylist 0 -1] + list $v1 $v2 $v3 + } {QUEUED OK {a b c}} + + test {Nested MULTI are not allowed} { + set err {} + r multi + catch {[r multi]} err + r exec + set _ $err + } {*ERR MULTI*} + + test {MULTI where commands alter argc/argv} { + r sadd myset a + r multi + r spop myset + list [r exec] [r exists myset] + } {a 0} + + test {WATCH inside MULTI is not allowed} { + set err {} + r multi + catch {[r watch x]} err + r exec + set _ $err + } {*ERR WATCH*} + + test {EXEC fails if there are errors while queueing commands #1} { + r del foo1 foo2 + r multi + r set foo1 bar1 + catch {r non-existing-command} + r set foo2 bar2 + catch {r exec} e + assert_match {EXECABORT*} $e + list [r exists foo1] [r exists foo2] + } {0 0} + + test {EXEC fails if there are errors while queueing commands #2} { + set rd [redis_deferring_client] + r del foo1 foo2 + r multi + r set foo1 bar1 + $rd config set maxmemory 1 + assert {[$rd read] eq {OK}} + catch {r lpush mylist myvalue} + $rd config set maxmemory 0 + assert {[$rd read] eq {OK}} + r set foo2 bar2 + catch {r exec} e + assert_match {EXECABORT*} $e + $rd close + list [r exists foo1] [r exists foo2] + } {0 0} + + test {If EXEC aborts, the client MULTI state is cleared} { + r del foo1 foo2 + r multi + r set foo1 bar1 + catch {r non-existing-command} + r set foo2 bar2 + catch {r exec} e + assert_match {EXECABORT*} $e + r ping + } {PONG} + + test {EXEC works on WATCHed key not modified} { + r watch x y z + r watch k + r multi + r ping + r exec + } {PONG} + + test {EXEC fail on WATCHed key modified (1 key of 1 watched)} { + r set x 30 + r watch x + r set x 40 + r multi + r ping + r exec + } {} + + test {EXEC fail on WATCHed key modified (1 key of 5 watched)} { + r set x 30 + r watch a b x k z + r set x 40 + r multi + r ping + r exec + } {} + + test {EXEC fail on WATCHed key modified by SORT with STORE even if the result is empty} { + r flushdb + r lpush foo bar + r watch foo + r sort emptylist store foo + r multi + r ping + r exec + } {} + + test {After successful EXEC key is no longer watched} { + r set x 30 + r watch x + r multi + r ping + r exec + r set x 40 + r multi + r ping + r exec + } {PONG} + + test {After failed EXEC key is no longer watched} { + r set x 30 + r watch x + r set x 40 + r multi + r ping + r exec + r set x 40 + r multi + r ping + r exec + } {PONG} + + test {It is possible to UNWATCH} { + r set x 30 + r watch x + r set x 40 + r unwatch + r multi + r ping + r exec + } {PONG} + + test {UNWATCH when there is nothing watched works as expected} { + r unwatch + } {OK} + + test {FLUSHALL is able to touch the watched keys} { + r set x 30 + r watch x + r flushall + r multi + r ping + r exec + } {} + + test {FLUSHALL does not touch non affected keys} { + r del x + r watch x + r flushall + r multi + r ping + r exec + } {PONG} + + test {FLUSHDB is able to touch the watched keys} { + r set x 30 + r watch x + r flushdb + r multi + r ping + r exec + } {} + + test {FLUSHDB does not touch non affected keys} { + r del x + r watch x + r flushdb + r multi + r ping + r exec + } {PONG} + + test {WATCH is able to remember the DB a key belongs to} { + r select 5 + r set x 30 + r watch x + r select 1 + r set x 10 + r select 5 + r multi + r ping + set res [r exec] + # Restore original DB + r select 9 + set res + } {PONG} + + test {WATCH will consider touched keys target of EXPIRE} { + r del x + r set x foo + r watch x + r expire x 10 + r multi + r ping + r exec + } {} + + test {WATCH will not consider touched expired keys} { + r del x + r set x foo + r expire x 1 + r watch x + after 1100 + r multi + r ping + r exec + } {PONG} + + test {DISCARD should clear the WATCH dirty flag on the client} { + r watch x + r set x 10 + r multi + r discard + r multi + r incr x + r exec + } {11} + + test {DISCARD should UNWATCH all the keys} { + r watch x + r set x 10 + r multi + r discard + r set x 10 + r multi + r incr x + r exec + } {11} + + test {MULTI / EXEC is propagated correctly (single write command)} { + set repl [attach_to_replication_stream] + r multi + r set foo bar + r exec + assert_replication_stream $repl { + {select *} + {multi} + {set foo bar} + {exec} + } + close_replication_stream $repl + } + + test {MULTI / EXEC is propagated correctly (empty transaction)} { + set repl [attach_to_replication_stream] + r multi + r exec + r set foo bar + assert_replication_stream $repl { + {select *} + {set foo bar} + } + close_replication_stream $repl + } + + test {MULTI / EXEC is propagated correctly (read-only commands)} { + r set foo value1 + set repl [attach_to_replication_stream] + r multi + r get foo + r exec + r set foo value2 + assert_replication_stream $repl { + {select *} + {set foo value2} + } + close_replication_stream $repl + } + + test {MULTI / EXEC is propagated correctly (write command, no effect)} { + r del bar foo bar + set repl [attach_to_replication_stream] + r multi + r del foo + r exec + assert_replication_stream $repl { + {select *} + {multi} + {exec} + } + close_replication_stream $repl + } +} diff --git a/pikatests/tests/unit/obuf-limits.tcl b/pikatests/tests/unit/obuf-limits.tcl new file mode 100644 index 0000000000..5d625cf453 --- /dev/null +++ b/pikatests/tests/unit/obuf-limits.tcl @@ -0,0 +1,73 @@ +start_server {tags {"obuf-limits"}} { + test {Client output buffer hard limit is enforced} { + r config set client-output-buffer-limit {pubsub 100000 0 0} + set rd1 [redis_deferring_client] + + $rd1 subscribe foo + set reply [$rd1 read] + assert {$reply eq "subscribe foo 1"} + + set omem 0 + while 1 { + r publish foo bar + set clients [split [r client list] "\r\n"] + set c [split [lindex $clients 1] " "] + if {![regexp {omem=([0-9]+)} $c - omem]} break + if {$omem > 200000} break + } + assert {$omem >= 90000 && $omem < 200000} + $rd1 close + } + + test {Client output buffer soft limit is not enforced if time is not overreached} { + r config set client-output-buffer-limit {pubsub 0 100000 10} + set rd1 [redis_deferring_client] + + $rd1 subscribe foo + set reply [$rd1 read] + assert {$reply eq "subscribe foo 1"} + + set omem 0 + set start_time 0 + set time_elapsed 0 + while 1 { + r publish foo bar + set clients [split [r client list] "\r\n"] + set c [split [lindex $clients 1] " "] + if {![regexp {omem=([0-9]+)} $c - omem]} break + if {$omem > 100000} { + if {$start_time == 0} {set start_time [clock seconds]} + set time_elapsed [expr {[clock seconds]-$start_time}] + if {$time_elapsed >= 5} break + } + } + assert {$omem >= 100000 && $time_elapsed >= 5 && $time_elapsed <= 10} + $rd1 close + } + + test {Client output buffer soft limit is enforced if time is overreached} { + r config set client-output-buffer-limit {pubsub 0 100000 3} + set rd1 [redis_deferring_client] + + $rd1 subscribe foo + set reply [$rd1 read] + assert {$reply eq "subscribe foo 1"} + + set omem 0 + set start_time 0 + set time_elapsed 0 + while 1 { + r publish foo bar + set clients [split [r client list] "\r\n"] + set c [split [lindex $clients 1] " "] + if {![regexp {omem=([0-9]+)} $c - omem]} break + if {$omem > 100000} { + if {$start_time == 0} {set start_time [clock seconds]} + set time_elapsed [expr {[clock seconds]-$start_time}] + if {$time_elapsed >= 10} break + } + } + assert {$omem >= 100000 && $time_elapsed < 6} + $rd1 close + } +} diff --git a/pikatests/tests/unit/other.tcl b/pikatests/tests/unit/other.tcl new file mode 100644 index 0000000000..a53f3f5c81 --- /dev/null +++ b/pikatests/tests/unit/other.tcl @@ -0,0 +1,245 @@ +start_server {tags {"other"}} { + if {$::force_failure} { + # This is used just for test suite development purposes. + test {Failing test} { + format err + } {ok} + } + + test {SAVE - make sure there are all the types as values} { + # Wait for a background saving in progress to terminate + waitForBgsave r + r lpush mysavelist hello + r lpush mysavelist world + r set myemptykey {} + r set mynormalkey {blablablba} + r zadd mytestzset 10 a + r zadd mytestzset 20 b + r zadd mytestzset 30 c + r save + } {OK} + + tags {slow} { + if {$::accurate} {set iterations 10000} else {set iterations 1000} + foreach fuzztype {binary alpha compr} { + test "FUZZ stresser with data model $fuzztype" { + set err 0 + for {set i 0} {$i < $iterations} {incr i} { + set fuzz [randstring 0 512 $fuzztype] + r set foo $fuzz + set got [r get foo] + if {$got ne $fuzz} { + set err [list $fuzz $got] + break + } + } + set _ $err + } {0} + } + } + + test {BGSAVE} { + waitForBgsave r + r flushdb + r save + r set x 10 + r bgsave + waitForBgsave r + r debug reload + r get x + } {10} + + test {SELECT an out of range DB} { + catch {r select 1000000} err + set _ $err + } {*invalid*} + + tags {consistency} { + if {![catch {package require sha1}]} { + if {$::accurate} {set numops 10000} else {set numops 1000} + test {Check consistency of different data types after a reload} { + r flushdb + createComplexDataset r $numops + set dump [csvdump r] + set sha1 [r debug digest] + r debug reload + set sha1_after [r debug digest] + if {$sha1 eq $sha1_after} { + set _ 1 + } else { + set newdump [csvdump r] + puts "Consistency test failed!" + puts "You can inspect the two dumps in /tmp/repldump*.txt" + + set fd [open /tmp/repldump1.txt w] + puts $fd $dump + close $fd + set fd [open /tmp/repldump2.txt w] + puts $fd $newdump + close $fd + + set _ 0 + } + } {1} + + test {Same dataset digest if saving/reloading as AOF?} { + r bgrewriteaof + waitForBgrewriteaof r + r debug loadaof + set sha1_after [r debug digest] + if {$sha1 eq $sha1_after} { + set _ 1 + } else { + set newdump [csvdump r] + puts "Consistency test failed!" + puts "You can inspect the two dumps in /tmp/aofdump*.txt" + + set fd [open /tmp/aofdump1.txt w] + puts $fd $dump + close $fd + set fd [open /tmp/aofdump2.txt w] + puts $fd $newdump + close $fd + + set _ 0 + } + } {1} + } + } + + test {EXPIRES after a reload (snapshot + append only file rewrite)} { + r flushdb + r set x 10 + r expire x 1000 + r save + r debug reload + set ttl [r ttl x] + set e1 [expr {$ttl > 900 && $ttl <= 1000}] + r bgrewriteaof + waitForBgrewriteaof r + r debug loadaof + set ttl [r ttl x] + set e2 [expr {$ttl > 900 && $ttl <= 1000}] + list $e1 $e2 + } {1 1} + + test {EXPIRES after AOF reload (without rewrite)} { + r flushdb + r config set appendonly yes + r set x somevalue + r expire x 1000 + r setex y 2000 somevalue + r set z somevalue + r expireat z [expr {[clock seconds]+3000}] + + # Milliseconds variants + r set px somevalue + r pexpire px 1000000 + r psetex py 2000000 somevalue + r set pz somevalue + r pexpireat pz [expr {([clock seconds]+3000)*1000}] + + # Reload and check + waitForBgrewriteaof r + # We need to wait two seconds to avoid false positives here, otherwise + # the DEBUG LOADAOF command may read a partial file. + # Another solution would be to set the fsync policy to no, since this + # prevents write() to be delayed by the completion of fsync(). + after 2000 + r debug loadaof + set ttl [r ttl x] + assert {$ttl > 900 && $ttl <= 1000} + set ttl [r ttl y] + assert {$ttl > 1900 && $ttl <= 2000} + set ttl [r ttl z] + assert {$ttl > 2900 && $ttl <= 3000} + set ttl [r ttl px] + assert {$ttl > 900 && $ttl <= 1000} + set ttl [r ttl py] + assert {$ttl > 1900 && $ttl <= 2000} + set ttl [r ttl pz] + assert {$ttl > 2900 && $ttl <= 3000} + r config set appendonly no + } + + tags {protocol} { + test {PIPELINING stresser (also a regression for the old epoll bug)} { + set fd2 [socket $::host $::port] + fconfigure $fd2 -encoding binary -translation binary + puts -nonewline $fd2 "SELECT 9\r\n" + flush $fd2 + gets $fd2 + + for {set i 0} {$i < 100000} {incr i} { + set q {} + set val "0000${i}0000" + append q "SET key:$i $val\r\n" + puts -nonewline $fd2 $q + set q {} + append q "GET key:$i\r\n" + puts -nonewline $fd2 $q + } + flush $fd2 + + for {set i 0} {$i < 100000} {incr i} { + gets $fd2 line + gets $fd2 count + set count [string range $count 1 end] + set val [read $fd2 $count] + read $fd2 2 + } + close $fd2 + set _ 1 + } {1} + } + + test {APPEND basics} { + list [r append foo bar] [r get foo] \ + [r append foo 100] [r get foo] + } {3 bar 6 bar100} + + test {APPEND basics, integer encoded values} { + set res {} + r del foo + r append foo 1 + r append foo 2 + lappend res [r get foo] + r set foo 1 + r append foo 2 + lappend res [r get foo] + } {12 12} + + test {APPEND fuzzing} { + set err {} + foreach type {binary alpha compr} { + set buf {} + r del x + for {set i 0} {$i < 1000} {incr i} { + set bin [randstring 0 10 $type] + append buf $bin + r append x $bin + } + if {$buf != [r get x]} { + set err "Expected '$buf' found '[r get x]'" + break + } + } + set _ $err + } {} + + # Leave the user with a clean DB before to exit + test {FLUSHDB} { + set aux {} + r select 9 + r flushdb + lappend aux [r dbsize] + r select 10 + r flushdb + lappend aux [r dbsize] + } {0 0} + + test {Perform a final SAVE to leave a clean DB on disk} { + waitForBgsave r + r save + } {OK} +} diff --git a/pikatests/tests/unit/printver.tcl b/pikatests/tests/unit/printver.tcl new file mode 100644 index 0000000000..c80f45144d --- /dev/null +++ b/pikatests/tests/unit/printver.tcl @@ -0,0 +1,6 @@ +start_server {} { + set i [r info] + regexp {redis_version:(.*?)\r\n} $i - version + regexp {redis_git_sha1:(.*?)\r\n} $i - sha1 + puts "Testing Redis version $version ($sha1)" +} diff --git a/pikatests/tests/unit/protocol.tcl b/pikatests/tests/unit/protocol.tcl new file mode 100644 index 0000000000..ac99c3abb4 --- /dev/null +++ b/pikatests/tests/unit/protocol.tcl @@ -0,0 +1,117 @@ +start_server {tags {"protocol"}} { + test "Handle an empty query" { + reconnect + r write "\r\n" + r flush + assert_equal "PONG" [r ping] + } + + test "Negative multibulk length" { + reconnect + r write "*-10\r\n" + r flush + assert_equal PONG [r ping] + } + + test "Out of range multibulk length" { + reconnect + r write "*20000000\r\n" + r flush + assert_error "*invalid multibulk length*" {r read} + } + + test "Wrong multibulk payload header" { + reconnect + r write "*3\r\n\$3\r\nSET\r\n\$1\r\nx\r\nfooz\r\n" + r flush + assert_error "*expected '$', got 'f'*" {r read} + } + + test "Negative multibulk payload length" { + reconnect + r write "*3\r\n\$3\r\nSET\r\n\$1\r\nx\r\n\$-10\r\n" + r flush + assert_error "*invalid bulk length*" {r read} + } + + test "Out of range multibulk payload length" { + reconnect + r write "*3\r\n\$3\r\nSET\r\n\$1\r\nx\r\n\$2000000000\r\n" + r flush + assert_error "*invalid bulk length*" {r read} + } + + test "Non-number multibulk payload length" { + reconnect + r write "*3\r\n\$3\r\nSET\r\n\$1\r\nx\r\n\$blabla\r\n" + r flush + assert_error "*invalid bulk length*" {r read} + } + + test "Multi bulk request not followed by bulk arguments" { + reconnect + r write "*1\r\nfoo\r\n" + r flush + assert_error "*expected '$', got 'f'*" {r read} + } + + test "Generic wrong number of args" { + reconnect + assert_error "*wrong*arguments*ping*" {r ping x y z} + } + + test "Unbalanced number of quotes" { + reconnect + r write "set \"\"\"test-key\"\"\" test-value\r\n" + r write "ping\r\n" + r flush + assert_error "*unbalanced*" {r read} + } + + set c 0 + foreach seq [list "\x00" "*\x00" "$\x00"] { + incr c + test "Protocol desync regression test #$c" { + set s [socket [srv 0 host] [srv 0 port]] + puts -nonewline $s $seq + set payload [string repeat A 1024]"\n" + set test_start [clock seconds] + set test_time_limit 30 + while 1 { + if {[catch { + puts -nonewline $s payload + flush $s + incr payload_size [string length $payload] + }]} { + set retval [gets $s] + close $s + break + } else { + set elapsed [expr {[clock seconds]-$test_start}] + if {$elapsed > $test_time_limit} { + close $s + error "assertion:Redis did not closed connection after protocol desync" + } + } + } + set retval + } {*Protocol error*} + } + unset c +} + +start_server {tags {"regression"}} { + test "Regression for a crash with blocking ops and pipelining" { + set rd [redis_deferring_client] + set fd [r channel] + set proto "*3\r\n\$5\r\nBLPOP\r\n\$6\r\nnolist\r\n\$1\r\n0\r\n" + puts -nonewline $fd $proto$proto + flush $fd + set res {} + + $rd rpush nolist a + $rd read + $rd rpush nolist a + $rd read + } +} diff --git a/pikatests/tests/unit/pubsub.tcl b/pikatests/tests/unit/pubsub.tcl new file mode 100644 index 0000000000..9c7a43bf0c --- /dev/null +++ b/pikatests/tests/unit/pubsub.tcl @@ -0,0 +1,390 @@ +start_server {tags {"pubsub"}} { + proc __consume_subscribe_messages {client type channels} { + set numsub -1 + set counts {} + + for {set i [llength $channels]} {$i > 0} {incr i -1} { + set msg [$client read] + assert_equal $type [lindex $msg 0] + + # when receiving subscribe messages the channels names + # are ordered. when receiving unsubscribe messages + # they are unordered + set idx [lsearch -exact $channels [lindex $msg 1]] + if {[string match "*unsubscribe" $type]} { + assert {$idx >= 0} + } else { + assert {$idx == 0} + } + set channels [lreplace $channels $idx $idx] + + # aggregate the subscription count to return to the caller + lappend counts [lindex $msg 2] + } + + # we should have received messages for channels + assert {[llength $channels] == 0} + return $counts + } + + proc subscribe {client channels} { + $client subscribe {*}$channels + __consume_subscribe_messages $client subscribe $channels + } + + proc unsubscribe {client {channels {}}} { + $client unsubscribe {*}$channels + __consume_subscribe_messages $client unsubscribe $channels + } + + proc psubscribe {client channels} { + $client psubscribe {*}$channels + __consume_subscribe_messages $client psubscribe $channels + } + + proc punsubscribe {client {channels {}}} { + $client punsubscribe {*}$channels + __consume_subscribe_messages $client punsubscribe $channels + } + + test "Pub/Sub PING" { + set rd1 [redis_deferring_client] + subscribe $rd1 somechannel + # While subscribed to non-zero channels PING works in Pub/Sub mode. + $rd1 ping + $rd1 ping "foo" + set reply1 [$rd1 read] + set reply2 [$rd1 read] + unsubscribe $rd1 somechannel + # Now we are unsubscribed, PING should just return PONG. + $rd1 ping + set reply3 [$rd1 read] + $rd1 close + list $reply1 $reply2 $reply3 + } {{pong {}} {pong foo} PONG} + + test "PUBLISH/SUBSCRIBE basics" { + set rd1 [redis_deferring_client] + + # subscribe to two channels + assert_equal {1 2} [subscribe $rd1 {chan1 chan2}] + assert_equal 1 [r publish chan1 hello] + assert_equal 1 [r publish chan2 world] + assert_equal {message chan1 hello} [$rd1 read] + assert_equal {message chan2 world} [$rd1 read] + + # unsubscribe from one of the channels + unsubscribe $rd1 {chan1} + assert_equal 0 [r publish chan1 hello] + assert_equal 1 [r publish chan2 world] + assert_equal {message chan2 world} [$rd1 read] + + # unsubscribe from the remaining channel + unsubscribe $rd1 {chan2} + assert_equal 0 [r publish chan1 hello] + assert_equal 0 [r publish chan2 world] + + # clean up clients + $rd1 close + } + + test "PUBLISH/SUBSCRIBE with two clients" { + set rd1 [redis_deferring_client] + set rd2 [redis_deferring_client] + + assert_equal {1} [subscribe $rd1 {chan1}] + assert_equal {1} [subscribe $rd2 {chan1}] + assert_equal 2 [r publish chan1 hello] + assert_equal {message chan1 hello} [$rd1 read] + assert_equal {message chan1 hello} [$rd2 read] + + # clean up clients + $rd1 close + $rd2 close + } + + test "PUBLISH/SUBSCRIBE after UNSUBSCRIBE without arguments" { + set rd1 [redis_deferring_client] + assert_equal {1 2 3} [subscribe $rd1 {chan1 chan2 chan3}] + unsubscribe $rd1 + assert_equal 0 [r publish chan1 hello] + assert_equal 0 [r publish chan2 hello] + assert_equal 0 [r publish chan3 hello] + + # clean up clients + $rd1 close + } + + test "SUBSCRIBE to one channel more than once" { + set rd1 [redis_deferring_client] + assert_equal {1 1 1} [subscribe $rd1 {chan1 chan1 chan1}] + assert_equal 1 [r publish chan1 hello] + assert_equal {message chan1 hello} [$rd1 read] + + # clean up clients + $rd1 close + } + + test "UNSUBSCRIBE from non-subscribed channels" { + set rd1 [redis_deferring_client] + assert_equal {0 0 0} [unsubscribe $rd1 {foo bar quux}] + + # clean up clients + $rd1 close + } + + test "PUBLISH/PSUBSCRIBE basics" { + set rd1 [redis_deferring_client] + + # subscribe to two patterns + assert_equal {1 2} [psubscribe $rd1 {foo.* bar.*}] + assert_equal 1 [r publish foo.1 hello] + assert_equal 1 [r publish bar.1 hello] + assert_equal 0 [r publish foo1 hello] + assert_equal 0 [r publish barfoo.1 hello] + assert_equal 0 [r publish qux.1 hello] + assert_equal {pmessage foo.* foo.1 hello} [$rd1 read] + assert_equal {pmessage bar.* bar.1 hello} [$rd1 read] + + # unsubscribe from one of the patterns + assert_equal {1} [punsubscribe $rd1 {foo.*}] + assert_equal 0 [r publish foo.1 hello] + assert_equal 1 [r publish bar.1 hello] + assert_equal {pmessage bar.* bar.1 hello} [$rd1 read] + + # unsubscribe from the remaining pattern + assert_equal {0} [punsubscribe $rd1 {bar.*}] + assert_equal 0 [r publish foo.1 hello] + assert_equal 0 [r publish bar.1 hello] + + # clean up clients + $rd1 close + } + + test "PUBLISH/PSUBSCRIBE with two clients" { + set rd1 [redis_deferring_client] + set rd2 [redis_deferring_client] + + assert_equal {1} [psubscribe $rd1 {chan.*}] + assert_equal {1} [psubscribe $rd2 {chan.*}] + assert_equal 2 [r publish chan.foo hello] + assert_equal {pmessage chan.* chan.foo hello} [$rd1 read] + assert_equal {pmessage chan.* chan.foo hello} [$rd2 read] + + # clean up clients + $rd1 close + $rd2 close + } + + test "PUBLISH/PSUBSCRIBE after PUNSUBSCRIBE without arguments" { + set rd1 [redis_deferring_client] + assert_equal {1 2 3} [psubscribe $rd1 {chan1.* chan2.* chan3.*}] + punsubscribe $rd1 + assert_equal 0 [r publish chan1.hi hello] + assert_equal 0 [r publish chan2.hi hello] + assert_equal 0 [r publish chan3.hi hello] + + # clean up clients + $rd1 close + } + + test "PUNSUBSCRIBE from non-subscribed channels" { + set rd1 [redis_deferring_client] + assert_equal {0 0 0} [punsubscribe $rd1 {foo.* bar.* quux.*}] + + # clean up clients + $rd1 close + } + + test "NUMSUB returns numbers, not strings (#1561)" { + r pubsub numsub abc def + } {abc 0 def 0} + + test "Mix SUBSCRIBE and PSUBSCRIBE" { + set rd1 [redis_deferring_client] + assert_equal {1} [subscribe $rd1 {foo.bar}] + assert_equal {2} [psubscribe $rd1 {foo.*}] + + assert_equal 2 [r publish foo.bar hello] + assert_equal {message foo.bar hello} [$rd1 read] + assert_equal {pmessage foo.* foo.bar hello} [$rd1 read] + + # clean up clients + $rd1 close + } + + test "PUNSUBSCRIBE and UNSUBSCRIBE should always reply" { + # Make sure we are not subscribed to any channel at all. + r punsubscribe + r unsubscribe + # Now check if the commands still reply correctly. + set reply1 [r punsubscribe] + set reply2 [r unsubscribe] + concat $reply1 $reply2 + } {punsubscribe {} 0 unsubscribe {} 0} + + ### Keyspace events notification tests + + test "Keyspace notifications: we receive keyspace notifications" { + r config set notify-keyspace-events KA + set rd1 [redis_deferring_client] + assert_equal {1} [psubscribe $rd1 *] + r set foo bar + assert_equal {pmessage * __keyspace@9__:foo set} [$rd1 read] + $rd1 close + } + + test "Keyspace notifications: we receive keyevent notifications" { + r config set notify-keyspace-events EA + set rd1 [redis_deferring_client] + assert_equal {1} [psubscribe $rd1 *] + r set foo bar + assert_equal {pmessage * __keyevent@9__:set foo} [$rd1 read] + $rd1 close + } + + test "Keyspace notifications: we can receive both kind of events" { + r config set notify-keyspace-events KEA + set rd1 [redis_deferring_client] + assert_equal {1} [psubscribe $rd1 *] + r set foo bar + assert_equal {pmessage * __keyspace@9__:foo set} [$rd1 read] + assert_equal {pmessage * __keyevent@9__:set foo} [$rd1 read] + $rd1 close + } + + test "Keyspace notifications: we are able to mask events" { + r config set notify-keyspace-events KEl + r del mylist + set rd1 [redis_deferring_client] + assert_equal {1} [psubscribe $rd1 *] + r set foo bar + r lpush mylist a + # No notification for set, because only list commands are enabled. + assert_equal {pmessage * __keyspace@9__:mylist lpush} [$rd1 read] + assert_equal {pmessage * __keyevent@9__:lpush mylist} [$rd1 read] + $rd1 close + } + + test "Keyspace notifications: general events test" { + r config set notify-keyspace-events KEg + set rd1 [redis_deferring_client] + assert_equal {1} [psubscribe $rd1 *] + r set foo bar + r expire foo 1 + r del foo + assert_equal {pmessage * __keyspace@9__:foo expire} [$rd1 read] + assert_equal {pmessage * __keyevent@9__:expire foo} [$rd1 read] + assert_equal {pmessage * __keyspace@9__:foo del} [$rd1 read] + assert_equal {pmessage * __keyevent@9__:del foo} [$rd1 read] + $rd1 close + } + + test "Keyspace notifications: list events test" { + r config set notify-keyspace-events KEl + r del mylist + set rd1 [redis_deferring_client] + assert_equal {1} [psubscribe $rd1 *] + r lpush mylist a + r rpush mylist a + r rpop mylist + assert_equal {pmessage * __keyspace@9__:mylist lpush} [$rd1 read] + assert_equal {pmessage * __keyevent@9__:lpush mylist} [$rd1 read] + assert_equal {pmessage * __keyspace@9__:mylist rpush} [$rd1 read] + assert_equal {pmessage * __keyevent@9__:rpush mylist} [$rd1 read] + assert_equal {pmessage * __keyspace@9__:mylist rpop} [$rd1 read] + assert_equal {pmessage * __keyevent@9__:rpop mylist} [$rd1 read] + $rd1 close + } + + test "Keyspace notifications: set events test" { + r config set notify-keyspace-events Ks + r del myset + set rd1 [redis_deferring_client] + assert_equal {1} [psubscribe $rd1 *] + r sadd myset a b c d + r srem myset x + r sadd myset x y z + r srem myset x + assert_equal {pmessage * __keyspace@9__:myset sadd} [$rd1 read] + assert_equal {pmessage * __keyspace@9__:myset sadd} [$rd1 read] + assert_equal {pmessage * __keyspace@9__:myset srem} [$rd1 read] + $rd1 close + } + + test "Keyspace notifications: zset events test" { + r config set notify-keyspace-events Kz + r del myzset + set rd1 [redis_deferring_client] + assert_equal {1} [psubscribe $rd1 *] + r zadd myzset 1 a 2 b + r zrem myzset x + r zadd myzset 3 x 4 y 5 z + r zrem myzset x + assert_equal {pmessage * __keyspace@9__:myzset zadd} [$rd1 read] + assert_equal {pmessage * __keyspace@9__:myzset zadd} [$rd1 read] + assert_equal {pmessage * __keyspace@9__:myzset zrem} [$rd1 read] + $rd1 close + } + + test "Keyspace notifications: hash events test" { + r config set notify-keyspace-events Kh + r del myhash + set rd1 [redis_deferring_client] + assert_equal {1} [psubscribe $rd1 *] + r hmset myhash yes 1 no 0 + r hincrby myhash yes 10 + assert_equal {pmessage * __keyspace@9__:myhash hset} [$rd1 read] + assert_equal {pmessage * __keyspace@9__:myhash hincrby} [$rd1 read] + $rd1 close + } + + test "Keyspace notifications: expired events (triggered expire)" { + r config set notify-keyspace-events Ex + r del foo + set rd1 [redis_deferring_client] + assert_equal {1} [psubscribe $rd1 *] + r psetex foo 100 1 + wait_for_condition 50 100 { + [r exists foo] == 0 + } else { + fail "Key does not expire?!" + } + assert_equal {pmessage * __keyevent@9__:expired foo} [$rd1 read] + $rd1 close + } + + test "Keyspace notifications: expired events (background expire)" { + r config set notify-keyspace-events Ex + r del foo + set rd1 [redis_deferring_client] + assert_equal {1} [psubscribe $rd1 *] + r psetex foo 100 1 + assert_equal {pmessage * __keyevent@9__:expired foo} [$rd1 read] + $rd1 close + } + + test "Keyspace notifications: evicted events" { + r config set notify-keyspace-events Ee + r config set maxmemory-policy allkeys-lru + r flushdb + set rd1 [redis_deferring_client] + assert_equal {1} [psubscribe $rd1 *] + r set foo bar + r config set maxmemory 1 + assert_equal {pmessage * __keyevent@9__:evicted foo} [$rd1 read] + r config set maxmemory 0 + $rd1 close + } + + test "Keyspace notifications: test CONFIG GET/SET of event flags" { + r config set notify-keyspace-events gKE + assert_equal {gKE} [lindex [r config get notify-keyspace-events] 1] + r config set notify-keyspace-events {$lshzxeKE} + assert_equal {$lshzxeKE} [lindex [r config get notify-keyspace-events] 1] + r config set notify-keyspace-events KA + assert_equal {AK} [lindex [r config get notify-keyspace-events] 1] + r config set notify-keyspace-events EA + assert_equal {AE} [lindex [r config get notify-keyspace-events] 1] + } +} diff --git a/pikatests/tests/unit/quit.tcl b/pikatests/tests/unit/quit.tcl new file mode 100644 index 0000000000..4cf440abf1 --- /dev/null +++ b/pikatests/tests/unit/quit.tcl @@ -0,0 +1,40 @@ +start_server {tags {"quit"}} { + proc format_command {args} { + set cmd "*[llength $args]\r\n" + foreach a $args { + append cmd "$[string length $a]\r\n$a\r\n" + } + set _ $cmd + } + + test "QUIT returns OK" { + reconnect + assert_equal OK [r quit] + assert_error * {r ping} + } + + test "Pipelined commands after QUIT must not be executed" { + reconnect + r write [format_command quit] + r write [format_command set foo bar] + r flush + assert_equal OK [r read] + assert_error * {r read} + + reconnect + assert_equal {} [r get foo] + } + + test "Pipelined commands after QUIT that exceed read buffer size" { + reconnect + r write [format_command quit] + r write [format_command set foo [string repeat "x" 1024]] + r flush + assert_equal OK [r read] + assert_error * {r read} + + reconnect + assert_equal {} [r get foo] + + } +} diff --git a/pikatests/tests/unit/scan.tcl b/pikatests/tests/unit/scan.tcl new file mode 100644 index 0000000000..1d84f128da --- /dev/null +++ b/pikatests/tests/unit/scan.tcl @@ -0,0 +1,239 @@ +start_server {tags {"scan"}} { + test "SCAN basic" { + r flushdb + r debug populate 1000 + + set cur 0 + set keys {} + while 1 { + set res [r scan $cur] + set cur [lindex $res 0] + set k [lindex $res 1] + lappend keys {*}$k + if {$cur == 0} break + } + + set keys [lsort -unique $keys] + assert_equal 1000 [llength $keys] + } + + test "SCAN COUNT" { + r flushdb + r debug populate 1000 + + set cur 0 + set keys {} + while 1 { + set res [r scan $cur count 5] + set cur [lindex $res 0] + set k [lindex $res 1] + lappend keys {*}$k + if {$cur == 0} break + } + + set keys [lsort -unique $keys] + assert_equal 1000 [llength $keys] + } + + test "SCAN MATCH" { + r flushdb + r debug populate 1000 + + set cur 0 + set keys {} + while 1 { + set res [r scan $cur match "key:1??"] + set cur [lindex $res 0] + set k [lindex $res 1] + lappend keys {*}$k + if {$cur == 0} break + } + + set keys [lsort -unique $keys] + assert_equal 100 [llength $keys] + } + + foreach enc {intset hashtable} { + test "SSCAN with encoding $enc" { + # Create the Set + r del set + if {$enc eq {intset}} { + set prefix "" + } else { + set prefix "ele:" + } + set elements {} + for {set j 0} {$j < 100} {incr j} { + lappend elements ${prefix}${j} + } + r sadd set {*}$elements + + # Verify that the encoding matches. + assert {[r object encoding set] eq $enc} + + # Test SSCAN + set cur 0 + set keys {} + while 1 { + set res [r sscan set $cur] + set cur [lindex $res 0] + set k [lindex $res 1] + lappend keys {*}$k + if {$cur == 0} break + } + + set keys [lsort -unique $keys] + assert_equal 100 [llength $keys] + } + } + + foreach enc {ziplist hashtable} { + test "HSCAN with encoding $enc" { + # Create the Hash + r del hash + if {$enc eq {ziplist}} { + set count 30 + } else { + set count 1000 + } + set elements {} + for {set j 0} {$j < $count} {incr j} { + lappend elements key:$j $j + } + r hmset hash {*}$elements + + # Verify that the encoding matches. + assert {[r object encoding hash] eq $enc} + + # Test HSCAN + set cur 0 + set keys {} + while 1 { + set res [r hscan hash $cur] + set cur [lindex $res 0] + set k [lindex $res 1] + lappend keys {*}$k + if {$cur == 0} break + } + + set keys2 {} + foreach {k v} $keys { + assert {$k eq "key:$v"} + lappend keys2 $k + } + + set keys2 [lsort -unique $keys2] + assert_equal $count [llength $keys2] + } + } + + foreach enc {ziplist skiplist} { + test "ZSCAN with encoding $enc" { + # Create the Sorted Set + r del zset + if {$enc eq {ziplist}} { + set count 30 + } else { + set count 1000 + } + set elements {} + for {set j 0} {$j < $count} {incr j} { + lappend elements $j key:$j + } + r zadd zset {*}$elements + + # Verify that the encoding matches. + assert {[r object encoding zset] eq $enc} + + # Test ZSCAN + set cur 0 + set keys {} + while 1 { + set res [r zscan zset $cur] + set cur [lindex $res 0] + set k [lindex $res 1] + lappend keys {*}$k + if {$cur == 0} break + } + + set keys2 {} + foreach {k v} $keys { + assert {$k eq "key:$v"} + lappend keys2 $k + } + + set keys2 [lsort -unique $keys2] + assert_equal $count [llength $keys2] + } + } + + test "SCAN guarantees check under write load" { + r flushdb + r debug populate 100 + + # We start scanning here, so keys from 0 to 99 should all be + # reported at the end of the iteration. + set keys {} + while 1 { + set res [r scan $cur] + set cur [lindex $res 0] + set k [lindex $res 1] + lappend keys {*}$k + if {$cur == 0} break + # Write 10 random keys at every SCAN iteration. + for {set j 0} {$j < 10} {incr j} { + r set addedkey:[randomInt 1000] foo + } + } + + set keys2 {} + foreach k $keys { + if {[string length $k] > 6} continue + lappend keys2 $k + } + + set keys2 [lsort -unique $keys2] + assert_equal 100 [llength $keys2] + } + + test "SSCAN with integer encoded object (issue #1345)" { + set objects {1 a} + r del set + r sadd set {*}$objects + set res [r sscan set 0 MATCH *a* COUNT 100] + assert_equal [lsort -unique [lindex $res 1]] {a} + set res [r sscan set 0 MATCH *1* COUNT 100] + assert_equal [lsort -unique [lindex $res 1]] {1} + } + + test "SSCAN with PATTERN" { + r del mykey + r sadd mykey foo fab fiz foobar 1 2 3 4 + set res [r sscan mykey 0 MATCH foo* COUNT 10000] + lsort -unique [lindex $res 1] + } {foo foobar} + + test "HSCAN with PATTERN" { + r del mykey + r hmset mykey foo 1 fab 2 fiz 3 foobar 10 1 a 2 b 3 c 4 d + set res [r hscan mykey 0 MATCH foo* COUNT 10000] + lsort -unique [lindex $res 1] + } {1 10 foo foobar} + + test "ZSCAN with PATTERN" { + r del mykey + r zadd mykey 1 foo 2 fab 3 fiz 10 foobar + set res [r zscan mykey 0 MATCH foo* COUNT 10000] + lsort -unique [lindex $res 1] + } + + test "ZSCAN scores: regression test for issue #2175" { + r del mykey + for {set j 0} {$j < 500} {incr j} { + r zadd mykey 9.8813129168249309e-323 $j + } + set res [lindex [r zscan mykey 0] 1] + set first_score [lindex $res 1] + assert {$first_score != 0} + } +} diff --git a/pikatests/tests/unit/scripting.tcl b/pikatests/tests/unit/scripting.tcl new file mode 100644 index 0000000000..e1cd2174ba --- /dev/null +++ b/pikatests/tests/unit/scripting.tcl @@ -0,0 +1,606 @@ +start_server {tags {"scripting"}} { + test {EVAL - Does Lua interpreter replies to our requests?} { + r eval {return 'hello'} 0 + } {hello} + + test {EVAL - Lua integer -> Redis protocol type conversion} { + r eval {return 100.5} 0 + } {100} + + test {EVAL - Lua string -> Redis protocol type conversion} { + r eval {return 'hello world'} 0 + } {hello world} + + test {EVAL - Lua true boolean -> Redis protocol type conversion} { + r eval {return true} 0 + } {1} + + test {EVAL - Lua false boolean -> Redis protocol type conversion} { + r eval {return false} 0 + } {} + + test {EVAL - Lua status code reply -> Redis protocol type conversion} { + r eval {return {ok='fine'}} 0 + } {fine} + + test {EVAL - Lua error reply -> Redis protocol type conversion} { + catch { + r eval {return {err='this is an error'}} 0 + } e + set _ $e + } {this is an error} + + test {EVAL - Lua table -> Redis protocol type conversion} { + r eval {return {1,2,3,'ciao',{1,2}}} 0 + } {1 2 3 ciao {1 2}} + + test {EVAL - Are the KEYS and ARGV arrays populated correctly?} { + r eval {return {KEYS[1],KEYS[2],ARGV[1],ARGV[2]}} 2 a b c d + } {a b c d} + + test {EVAL - is Lua able to call Redis API?} { + r set mykey myval + r eval {return redis.call('get',KEYS[1])} 1 mykey + } {myval} + + test {EVALSHA - Can we call a SHA1 if already defined?} { + r evalsha fd758d1589d044dd850a6f05d52f2eefd27f033f 1 mykey + } {myval} + + test {EVALSHA - Can we call a SHA1 in uppercase?} { + r evalsha FD758D1589D044DD850A6F05D52F2EEFD27F033F 1 mykey + } {myval} + + test {EVALSHA - Do we get an error on invalid SHA1?} { + catch {r evalsha NotValidShaSUM 0} e + set _ $e + } {NOSCRIPT*} + + test {EVALSHA - Do we get an error on non defined SHA1?} { + catch {r evalsha ffd632c7d33e571e9f24556ebed26c3479a87130 0} e + set _ $e + } {NOSCRIPT*} + + test {EVAL - Redis integer -> Lua type conversion} { + r eval { + local foo = redis.pcall('incr','x') + return {type(foo),foo} + } 0 + } {number 1} + + test {EVAL - Redis bulk -> Lua type conversion} { + r set mykey myval + r eval { + local foo = redis.pcall('get','mykey') + return {type(foo),foo} + } 0 + } {string myval} + + test {EVAL - Redis multi bulk -> Lua type conversion} { + r del mylist + r rpush mylist a + r rpush mylist b + r rpush mylist c + r eval { + local foo = redis.pcall('lrange','mylist',0,-1) + return {type(foo),foo[1],foo[2],foo[3],# foo} + } 0 + } {table a b c 3} + + test {EVAL - Redis status reply -> Lua type conversion} { + r eval { + local foo = redis.pcall('set','mykey','myval') + return {type(foo),foo['ok']} + } 0 + } {table OK} + + test {EVAL - Redis error reply -> Lua type conversion} { + r set mykey myval + r eval { + local foo = redis.pcall('incr','mykey') + return {type(foo),foo['err']} + } 0 + } {table {ERR value is not an integer or out of range}} + + test {EVAL - Redis nil bulk reply -> Lua type conversion} { + r del mykey + r eval { + local foo = redis.pcall('get','mykey') + return {type(foo),foo == false} + } 0 + } {boolean 1} + + test {EVAL - Is the Lua client using the currently selected DB?} { + r set mykey "this is DB 9" + r select 10 + r set mykey "this is DB 10" + r eval {return redis.pcall('get','mykey')} 0 + } {this is DB 10} + + test {EVAL - SELECT inside Lua should not affect the caller} { + # here we DB 10 is selected + r set mykey "original value" + r eval {return redis.pcall('select','9')} 0 + set res [r get mykey] + r select 9 + set res + } {original value} + + if 0 { + test {EVAL - Script can't run more than configured time limit} { + r config set lua-time-limit 1 + catch { + r eval { + local i = 0 + while true do i=i+1 end + } 0 + } e + set _ $e + } {*execution time*} + } + + test {EVAL - Scripts can't run certain commands} { + set e {} + catch {r eval {return redis.pcall('spop','x')} 0} e + set e + } {*not allowed*} + + test {EVAL - Scripts can't run certain commands} { + set e {} + catch { + r eval "redis.pcall('randomkey'); return redis.pcall('set','x','ciao')" 0 + } e + set e + } {*not allowed after*} + + test {EVAL - No arguments to redis.call/pcall is considered an error} { + set e {} + catch {r eval {return redis.call()} 0} e + set e + } {*one argument*} + + test {EVAL - redis.call variant raises a Lua error on Redis cmd error (1)} { + set e {} + catch { + r eval "redis.call('nosuchcommand')" 0 + } e + set e + } {*Unknown Redis*} + + test {EVAL - redis.call variant raises a Lua error on Redis cmd error (1)} { + set e {} + catch { + r eval "redis.call('get','a','b','c')" 0 + } e + set e + } {*number of args*} + + test {EVAL - redis.call variant raises a Lua error on Redis cmd error (1)} { + set e {} + r set foo bar + catch { + r eval {redis.call('lpush',KEYS[1],'val')} 1 foo + } e + set e + } {*against a key*} + + test {EVAL - JSON numeric decoding} { + # We must return the table as a string because otherwise + # Redis converts floats to ints and we get 0 and 1023 instead + # of 0.0003 and 1023.2 as the parsed output. + r eval {return + table.concat( + cjson.decode( + "[0.0, -5e3, -1, 0.3e-3, 1023.2, 0e10]"), " ") + } 0 + } {0 -5000 -1 0.0003 1023.2 0} + + test {EVAL - JSON string decoding} { + r eval {local decoded = cjson.decode('{"keya": "a", "keyb": "b"}') + return {decoded.keya, decoded.keyb} + } 0 + } {a b} + + test {EVAL - cmsgpack can pack double?} { + r eval {local encoded = cmsgpack.pack(0.1) + local h = "" + for i = 1, #encoded do + h = h .. string.format("%02x",string.byte(encoded,i)) + end + return h + } 0 + } {cb3fb999999999999a} + + test {EVAL - cmsgpack can pack negative int64?} { + r eval {local encoded = cmsgpack.pack(-1099511627776) + local h = "" + for i = 1, #encoded do + h = h .. string.format("%02x",string.byte(encoded,i)) + end + return h + } 0 + } {d3ffffff0000000000} + + test {EVAL - cmsgpack can pack and unpack circular references?} { + r eval {local a = {x=nil,y=5} + local b = {x=a} + a['x'] = b + local encoded = cmsgpack.pack(a) + local h = "" + -- cmsgpack encodes to a depth of 16, but can't encode + -- references, so the encoded object has a deep copy recusive + -- depth of 16. + for i = 1, #encoded do + h = h .. string.format("%02x",string.byte(encoded,i)) + end + -- when unpacked, re.x.x != re because the unpack creates + -- individual tables down to a depth of 16. + -- (that's why the encoded output is so large) + local re = cmsgpack.unpack(encoded) + assert(re) + assert(re.x) + assert(re.x.x.y == re.y) + assert(re.x.x.x.x.y == re.y) + assert(re.x.x.x.x.x.x.y == re.y) + assert(re.x.x.x.x.x.x.x.x.x.x.y == re.y) + -- maximum working depth: + assert(re.x.x.x.x.x.x.x.x.x.x.x.x.x.x.y == re.y) + -- now the last x would be b above and has no y + assert(re.x.x.x.x.x.x.x.x.x.x.x.x.x.x.x) + -- so, the final x.x is at the depth limit and was assigned nil + assert(re.x.x.x.x.x.x.x.x.x.x.x.x.x.x.x.x == nil) + return {h, re.x.x.x.x.x.x.x.x.y == re.y, re.y == 5} + } 0 + } {82a17905a17881a17882a17905a17881a17882a17905a17881a17882a17905a17881a17882a17905a17881a17882a17905a17881a17882a17905a17881a17882a17905a17881a178c0 1 1} + + test {EVAL - Numerical sanity check from bitop} { + r eval {assert(0x7fffffff == 2147483647, "broken hex literals"); + assert(0xffffffff == -1 or 0xffffffff == 2^32-1, + "broken hex literals"); + assert(tostring(-1) == "-1", "broken tostring()"); + assert(tostring(0xffffffff) == "-1" or + tostring(0xffffffff) == "4294967295", + "broken tostring()") + } 0 + } {} + + test {EVAL - Verify minimal bitop functionality} { + r eval {assert(bit.tobit(1) == 1); + assert(bit.band(1) == 1); + assert(bit.bxor(1,2) == 3); + assert(bit.bor(1,2,4,8,16,32,64,128) == 255) + } 0 + } {} + + test {SCRIPTING FLUSH - is able to clear the scripts cache?} { + r set mykey myval + set v [r evalsha fd758d1589d044dd850a6f05d52f2eefd27f033f 1 mykey] + assert_equal $v myval + set e "" + r script flush + catch {r evalsha fd758d1589d044dd850a6f05d52f2eefd27f033f 1 mykey} e + set e + } {NOSCRIPT*} + + test {SCRIPT EXISTS - can detect already defined scripts?} { + r eval "return 1+1" 0 + r script exists a27e7e8a43702b7046d4f6a7ccf5b60cef6b9bd9 a27e7e8a43702b7046d4f6a7ccf5b60cef6b9bda + } {1 0} + + test {SCRIPT LOAD - is able to register scripts in the scripting cache} { + list \ + [r script load "return 'loaded'"] \ + [r evalsha b534286061d4b9e4026607613b95c06c06015ae8 0] + } {b534286061d4b9e4026607613b95c06c06015ae8 loaded} + + test "In the context of Lua the output of random commands gets ordered" { + r del myset + r sadd myset a b c d e f g h i l m n o p q r s t u v z aa aaa azz + r eval {return redis.call('smembers',KEYS[1])} 1 myset + } {a aa aaa azz b c d e f g h i l m n o p q r s t u v z} + + test "SORT is normally not alpha re-ordered for the scripting engine" { + r del myset + r sadd myset 1 2 3 4 10 + r eval {return redis.call('sort',KEYS[1],'desc')} 1 myset + } {10 4 3 2 1} + + test "SORT BY output gets ordered for scripting" { + r del myset + r sadd myset a b c d e f g h i l m n o p q r s t u v z aa aaa azz + r eval {return redis.call('sort',KEYS[1],'by','_')} 1 myset + } {a aa aaa azz b c d e f g h i l m n o p q r s t u v z} + + test "SORT BY with GET gets ordered for scripting" { + r del myset + r sadd myset a b c + r eval {return redis.call('sort',KEYS[1],'by','_','get','#','get','_:*')} 1 myset + } {a {} b {} c {}} + + test "redis.sha1hex() implementation" { + list [r eval {return redis.sha1hex('')} 0] \ + [r eval {return redis.sha1hex('Pizza & Mandolino')} 0] + } {da39a3ee5e6b4b0d3255bfef95601890afd80709 74822d82031af7493c20eefa13bd07ec4fada82f} + + test {Globals protection reading an undeclared global variable} { + catch {r eval {return a} 0} e + set e + } {*ERR*attempted to access unexisting global*} + + test {Globals protection setting an undeclared global*} { + catch {r eval {a=10} 0} e + set e + } {*ERR*attempted to create global*} + + test {Test an example script DECR_IF_GT} { + set decr_if_gt { + local current + + current = redis.call('get',KEYS[1]) + if not current then return nil end + if current > ARGV[1] then + return redis.call('decr',KEYS[1]) + else + return redis.call('get',KEYS[1]) + end + } + r set foo 5 + set res {} + lappend res [r eval $decr_if_gt 1 foo 2] + lappend res [r eval $decr_if_gt 1 foo 2] + lappend res [r eval $decr_if_gt 1 foo 2] + lappend res [r eval $decr_if_gt 1 foo 2] + lappend res [r eval $decr_if_gt 1 foo 2] + set res + } {4 3 2 2 2} + + test {Scripting engine resets PRNG at every script execution} { + set rand1 [r eval {return tostring(math.random())} 0] + set rand2 [r eval {return tostring(math.random())} 0] + assert_equal $rand1 $rand2 + } + + test {Scripting engine PRNG can be seeded correctly} { + set rand1 [r eval { + math.randomseed(ARGV[1]); return tostring(math.random()) + } 0 10] + set rand2 [r eval { + math.randomseed(ARGV[1]); return tostring(math.random()) + } 0 10] + set rand3 [r eval { + math.randomseed(ARGV[1]); return tostring(math.random()) + } 0 20] + assert_equal $rand1 $rand2 + assert {$rand2 ne $rand3} + } + + test {EVAL does not leak in the Lua stack} { + r set x 0 + # Use a non blocking client to speedup the loop. + set rd [redis_deferring_client] + for {set j 0} {$j < 10000} {incr j} { + $rd eval {return redis.call("incr",KEYS[1])} 1 x + } + for {set j 0} {$j < 10000} {incr j} { + $rd read + } + assert {[s used_memory_lua] < 1024*100} + $rd close + r get x + } {10000} + + test {EVAL processes writes from AOF in read-only slaves} { + r flushall + r config set appendonly yes + r eval {redis.call("set",KEYS[1],"100")} 1 foo + r eval {redis.call("incr",KEYS[1])} 1 foo + r eval {redis.call("incr",KEYS[1])} 1 foo + wait_for_condition 50 100 { + [s aof_rewrite_in_progress] == 0 + } else { + fail "AOF rewrite can't complete after CONFIG SET appendonly yes." + } + r config set slave-read-only yes + r slaveof 127.0.0.1 0 + r debug loadaof + set res [r get foo] + r slaveof no one + set res + } {102} + + test {We can call scripts rewriting client->argv from Lua} { + r del myset + r sadd myset a b c + r mset a 1 b 2 c 3 d 4 + assert {[r spop myset] ne {}} + assert {[r spop myset] ne {}} + assert {[r spop myset] ne {}} + assert {[r mget a b c d] eq {1 2 3 4}} + assert {[r spop myset] eq {}} + } + + test {Call Redis command with many args from Lua (issue #1764)} { + r eval { + local i + local x={} + redis.call('del','mylist') + for i=1,100 do + table.insert(x,i) + end + redis.call('rpush','mylist',unpack(x)) + return redis.call('lrange','mylist',0,-1) + } 0 + } {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100} + + test {Number conversion precision test (issue #1118)} { + r eval { + local value = 9007199254740991 + redis.call("set","foo",value) + return redis.call("get","foo") + } 0 + } {9007199254740991} + + test {String containing number precision test (regression of issue #1118)} { + r eval { + redis.call("set", "key", "12039611435714932082") + return redis.call("get", "key") + } 0 + } {12039611435714932082} + + test {Verify negative arg count is error instead of crash (issue #1842)} { + catch { r eval { return "hello" } -12 } e + set e + } {ERR Number of keys can't be negative} + + test {Correct handling of reused argv (issue #1939)} { + r eval { + for i = 0, 10 do + redis.call('SET', 'a', '1') + redis.call('MGET', 'a', 'b', 'c') + redis.call('EXPIRE', 'a', 0) + redis.call('GET', 'a') + redis.call('MGET', 'a', 'b', 'c') + end + } 0 + } +} + +# Start a new server since the last test in this stanza will kill the +# instance at all. +start_server {tags {"scripting"}} { + test {Timedout read-only scripts can be killed by SCRIPT KILL} { + set rd [redis_deferring_client] + r config set lua-time-limit 10 + $rd eval {while true do end} 0 + after 200 + catch {r ping} e + assert_match {BUSY*} $e + r script kill + after 200 ; # Give some time to Lua to call the hook again... + assert_equal [r ping] "PONG" + } + + test {Timedout script link is still usable after Lua returns} { + r config set lua-time-limit 10 + r eval {for i=1,100000 do redis.call('ping') end return 'ok'} 0 + r ping + } {PONG} + + test {Timedout scripts that modified data can't be killed by SCRIPT KILL} { + set rd [redis_deferring_client] + r config set lua-time-limit 10 + $rd eval {redis.call('set',KEYS[1],'y'); while true do end} 1 x + after 200 + catch {r ping} e + assert_match {BUSY*} $e + catch {r script kill} e + assert_match {UNKILLABLE*} $e + catch {r ping} e + assert_match {BUSY*} $e + } + + # Note: keep this test at the end of this server stanza because it + # kills the server. + test {SHUTDOWN NOSAVE can kill a timedout script anyway} { + # The server sould be still unresponding to normal commands. + catch {r ping} e + assert_match {BUSY*} $e + catch {r shutdown nosave} + # Make sure the server was killed + catch {set rd [redis_deferring_client]} e + assert_match {*connection refused*} $e + } +} + +start_server {tags {"scripting repl"}} { + start_server {} { + test {Before the slave connects we issue two EVAL commands} { + # One with an error, but still executing a command. + # SHA is: 67164fc43fa971f76fd1aaeeaf60c1c178d25876 + catch { + r eval {redis.call('incr',KEYS[1]); redis.call('nonexisting')} 1 x + } + # One command is correct: + # SHA is: 6f5ade10a69975e903c6d07b10ea44c6382381a5 + r eval {return redis.call('incr',KEYS[1])} 1 x + } {2} + + test {Connect a slave to the main instance} { + r -1 slaveof [srv 0 host] [srv 0 port] + wait_for_condition 50 100 { + [s -1 role] eq {slave} && + [string match {*master_link_status:up*} [r -1 info replication]] + } else { + fail "Can't turn the instance into a slave" + } + } + + test {Now use EVALSHA against the master, with both SHAs} { + # The server should replicate successful and unsuccessful + # commands as EVAL instead of EVALSHA. + catch { + r evalsha 67164fc43fa971f76fd1aaeeaf60c1c178d25876 1 x + } + r evalsha 6f5ade10a69975e903c6d07b10ea44c6382381a5 1 x + } {4} + + test {If EVALSHA was replicated as EVAL, 'x' should be '4'} { + wait_for_condition 50 100 { + [r -1 get x] eq {4} + } else { + fail "Expected 4 in x, but value is '[r -1 get x]'" + } + } + + test {Replication of script multiple pushes to list with BLPOP} { + set rd [redis_deferring_client] + $rd brpop a 0 + r eval { + redis.call("lpush",KEYS[1],"1"); + redis.call("lpush",KEYS[1],"2"); + } 1 a + set res [$rd read] + $rd close + wait_for_condition 50 100 { + [r -1 lrange a 0 -1] eq [r lrange a 0 -1] + } else { + fail "Expected list 'a' in slave and master to be the same, but they are respectively '[r -1 lrange a 0 -1]' and '[r lrange a 0 -1]'" + } + set res + } {a 1} + + test {EVALSHA replication when first call is readonly} { + r del x + r eval {if tonumber(ARGV[1]) > 0 then redis.call('incr', KEYS[1]) end} 1 x 0 + r evalsha 6e0e2745aa546d0b50b801a20983b70710aef3ce 1 x 0 + r evalsha 6e0e2745aa546d0b50b801a20983b70710aef3ce 1 x 1 + wait_for_condition 50 100 { + [r -1 get x] eq {1} + } else { + fail "Expected 1 in x, but value is '[r -1 get x]'" + } + } + + test {Lua scripts using SELECT are replicated correctly} { + r eval { + redis.call("set","foo1","bar1") + redis.call("select","10") + redis.call("incr","x") + redis.call("select","11") + redis.call("incr","z") + } 0 + r eval { + redis.call("set","foo1","bar1") + redis.call("select","10") + redis.call("incr","x") + redis.call("select","11") + redis.call("incr","z") + } 0 + wait_for_condition 50 100 { + [r -1 debug digest] eq [r debug digest] + } else { + fail "Master-Slave desync after Lua script using SELECT." + } + } + } +} diff --git a/pikatests/tests/unit/slowlog.tcl b/pikatests/tests/unit/slowlog.tcl new file mode 100644 index 0000000000..b25b91e2ce --- /dev/null +++ b/pikatests/tests/unit/slowlog.tcl @@ -0,0 +1,70 @@ +start_server {tags {"slowlog"} overrides {slowlog-log-slower-than 1000000}} { + test {SLOWLOG - check that it starts with an empty log} { + r slowlog len + } {0} + + test {SLOWLOG - only logs commands taking more time than specified} { + r config set slowlog-log-slower-than 100000 + r ping + assert_equal [r slowlog len] 0 + r debug sleep 0.2 + assert_equal [r slowlog len] 1 + } + + test {SLOWLOG - max entries is correctly handled} { + r config set slowlog-log-slower-than 0 + r config set slowlog-max-len 10 + for {set i 0} {$i < 100} {incr i} { + r ping + } + r slowlog len + } {10} + + test {SLOWLOG - GET optional argument to limit output len works} { + llength [r slowlog get 5] + } {5} + + test {SLOWLOG - RESET subcommand works} { + r config set slowlog-log-slower-than 100000 + r slowlog reset + r slowlog len + } {0} + + test {SLOWLOG - logged entry sanity check} { + r debug sleep 0.2 + set e [lindex [r slowlog get] 0] + assert_equal [llength $e] 4 + assert_equal [lindex $e 0] 105 + assert_equal [expr {[lindex $e 2] > 100000}] 1 + assert_equal [lindex $e 3] {debug sleep 0.2} + } + + test {SLOWLOG - commands with too many arguments are trimmed} { + r config set slowlog-log-slower-than 0 + r slowlog reset + r sadd set 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 + set e [lindex [r slowlog get] 0] + lindex $e 3 + } {sadd set 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 {... (2 more arguments)}} + + test {SLOWLOG - too long arguments are trimmed} { + r config set slowlog-log-slower-than 0 + r slowlog reset + set arg [string repeat A 129] + r sadd set foo $arg + set e [lindex [r slowlog get] 0] + lindex $e 3 + } {sadd set foo {AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA... (1 more bytes)}} + + test {SLOWLOG - EXEC is not logged, just executed commands} { + r config set slowlog-log-slower-than 100000 + r slowlog reset + assert_equal [r slowlog len] 0 + r multi + r debug sleep 0.2 + r exec + assert_equal [r slowlog len] 1 + set e [lindex [r slowlog get] 0] + assert_equal [lindex $e 3] {debug sleep 0.2} + } +} diff --git a/pikatests/tests/unit/sort.tcl b/pikatests/tests/unit/sort.tcl new file mode 100644 index 0000000000..a25ffeb5ce --- /dev/null +++ b/pikatests/tests/unit/sort.tcl @@ -0,0 +1,311 @@ +start_server { + tags {"sort"} + overrides { + "list-max-ziplist-value" 16 + "list-max-ziplist-entries" 32 + "set-max-intset-entries" 32 + } +} { + proc create_random_dataset {num cmd} { + set tosort {} + set result {} + array set seenrand {} + r del tosort + for {set i 0} {$i < $num} {incr i} { + # Make sure all the weights are different because + # Redis does not use a stable sort but Tcl does. + while 1 { + randpath { + set rint [expr int(rand()*1000000)] + } { + set rint [expr rand()] + } + if {![info exists seenrand($rint)]} break + } + set seenrand($rint) x + r $cmd tosort $i + r set weight_$i $rint + r hset wobj_$i weight $rint + lappend tosort [list $i $rint] + } + set sorted [lsort -index 1 -real $tosort] + for {set i 0} {$i < $num} {incr i} { + lappend result [lindex $sorted $i 0] + } + set _ $result + } + + foreach {num cmd enc title} { + 16 lpush ziplist "Ziplist" + 1000 lpush linkedlist "Linked list" + 10000 lpush linkedlist "Big Linked list" + 16 sadd intset "Intset" + 1000 sadd hashtable "Hash table" + 10000 sadd hashtable "Big Hash table" + } { + set result [create_random_dataset $num $cmd] + assert_encoding $enc tosort + + test "$title: SORT BY key" { + assert_equal $result [r sort tosort BY weight_*] + } + + test "$title: SORT BY key with limit" { + assert_equal [lrange $result 5 9] [r sort tosort BY weight_* LIMIT 5 5] + } + + test "$title: SORT BY hash field" { + assert_equal $result [r sort tosort BY wobj_*->weight] + } + } + + set result [create_random_dataset 16 lpush] + test "SORT GET #" { + assert_equal [lsort -integer $result] [r sort tosort GET #] + } + + test "SORT GET " { + r del foo + set res [r sort tosort GET foo] + assert_equal 16 [llength $res] + foreach item $res { assert_equal {} $item } + } + + test "SORT GET (key and hash) with sanity check" { + set l1 [r sort tosort GET # GET weight_*] + set l2 [r sort tosort GET # GET wobj_*->weight] + foreach {id1 w1} $l1 {id2 w2} $l2 { + assert_equal $id1 $id2 + assert_equal $w1 [r get weight_$id1] + assert_equal $w2 [r get weight_$id1] + } + } + + test "SORT BY key STORE" { + r sort tosort BY weight_* store sort-res + assert_equal $result [r lrange sort-res 0 -1] + assert_equal 16 [r llen sort-res] + assert_encoding ziplist sort-res + } + + test "SORT BY hash field STORE" { + r sort tosort BY wobj_*->weight store sort-res + assert_equal $result [r lrange sort-res 0 -1] + assert_equal 16 [r llen sort-res] + assert_encoding ziplist sort-res + } + + test "SORT DESC" { + assert_equal [lsort -decreasing -integer $result] [r sort tosort DESC] + } + + test "SORT ALPHA against integer encoded strings" { + r del mylist + r lpush mylist 2 + r lpush mylist 1 + r lpush mylist 3 + r lpush mylist 10 + r sort mylist alpha + } {1 10 2 3} + + test "SORT sorted set" { + r del zset + r zadd zset 1 a + r zadd zset 5 b + r zadd zset 2 c + r zadd zset 10 d + r zadd zset 3 e + r sort zset alpha desc + } {e d c b a} + + test "SORT sorted set BY nosort should retain ordering" { + r del zset + r zadd zset 1 a + r zadd zset 5 b + r zadd zset 2 c + r zadd zset 10 d + r zadd zset 3 e + r multi + r sort zset by nosort asc + r sort zset by nosort desc + r exec + } {{a c e b d} {d b e c a}} + + test "SORT sorted set BY nosort + LIMIT" { + r del zset + r zadd zset 1 a + r zadd zset 5 b + r zadd zset 2 c + r zadd zset 10 d + r zadd zset 3 e + assert_equal [r sort zset by nosort asc limit 0 1] {a} + assert_equal [r sort zset by nosort desc limit 0 1] {d} + assert_equal [r sort zset by nosort asc limit 0 2] {a c} + assert_equal [r sort zset by nosort desc limit 0 2] {d b} + assert_equal [r sort zset by nosort limit 5 10] {} + assert_equal [r sort zset by nosort limit -10 100] {a c e b d} + } + + test "SORT sorted set BY nosort works as expected from scripts" { + r del zset + r zadd zset 1 a + r zadd zset 5 b + r zadd zset 2 c + r zadd zset 10 d + r zadd zset 3 e + r eval { + return {redis.call('sort',KEYS[1],'by','nosort','asc'), + redis.call('sort',KEYS[1],'by','nosort','desc')} + } 1 zset + } {{a c e b d} {d b e c a}} + + test "SORT sorted set: +inf and -inf handling" { + r del zset + r zadd zset -100 a + r zadd zset 200 b + r zadd zset -300 c + r zadd zset 1000000 d + r zadd zset +inf max + r zadd zset -inf min + r zrange zset 0 -1 + } {min c a b d max} + + test "SORT regression for issue #19, sorting floats" { + r flushdb + set floats {1.1 5.10 3.10 7.44 2.1 5.75 6.12 0.25 1.15} + foreach x $floats { + r lpush mylist $x + } + assert_equal [lsort -real $floats] [r sort mylist] + } + + test "SORT with STORE returns zero if result is empty (github issue 224)" { + r flushdb + r sort foo store bar + } {0} + + test "SORT with STORE does not create empty lists (github issue 224)" { + r flushdb + r lpush foo bar + r sort foo alpha limit 10 10 store zap + r exists zap + } {0} + + test "SORT with STORE removes key if result is empty (github issue 227)" { + r flushdb + r lpush foo bar + r sort emptylist store foo + r exists foo + } {0} + + test "SORT with BY and STORE should still order output" { + r del myset mylist + r sadd myset a b c d e f g h i l m n o p q r s t u v z aa aaa azz + r sort myset alpha by _ store mylist + r lrange mylist 0 -1 + } {a aa aaa azz b c d e f g h i l m n o p q r s t u v z} + + test "SORT will complain with numerical sorting and bad doubles (1)" { + r del myset + r sadd myset 1 2 3 4 not-a-double + set e {} + catch {r sort myset} e + set e + } {*ERR*double*} + + test "SORT will complain with numerical sorting and bad doubles (2)" { + r del myset + r sadd myset 1 2 3 4 + r mset score:1 10 score:2 20 score:3 30 score:4 not-a-double + set e {} + catch {r sort myset by score:*} e + set e + } {*ERR*double*} + + test "SORT BY sub-sorts lexicographically if score is the same" { + r del myset + r sadd myset a b c d e f g h i l m n o p q r s t u v z aa aaa azz + foreach ele {a aa aaa azz b c d e f g h i l m n o p q r s t u v z} { + set score:$ele 100 + } + r sort myset by score:* + } {a aa aaa azz b c d e f g h i l m n o p q r s t u v z} + + test "SORT GET with pattern ending with just -> does not get hash field" { + r del mylist + r lpush mylist a + r set x:a-> 100 + r sort mylist by num get x:*-> + } {100} + + test "SORT by nosort retains native order for lists" { + r del testa + r lpush testa 2 1 4 3 5 + r sort testa by nosort + } {5 3 4 1 2} + + test "SORT by nosort plus store retains native order for lists" { + r del testa + r lpush testa 2 1 4 3 5 + r sort testa by nosort store testb + r lrange testb 0 -1 + } {5 3 4 1 2} + + test "SORT by nosort with limit returns based on original list order" { + r sort testa by nosort limit 0 3 store testb + r lrange testb 0 -1 + } {5 3 4} + + tags {"slow"} { + set num 100 + set res [create_random_dataset $num lpush] + + test "SORT speed, $num element list BY key, 100 times" { + set start [clock clicks -milliseconds] + for {set i 0} {$i < 100} {incr i} { + set sorted [r sort tosort BY weight_* LIMIT 0 10] + } + set elapsed [expr [clock clicks -milliseconds]-$start] + 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" { + set start [clock clicks -milliseconds] + for {set i 0} {$i < 100} {incr i} { + set sorted [r sort tosort BY wobj_*->weight LIMIT 0 10] + } + set elapsed [expr [clock clicks -milliseconds]-$start] + 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" { + set start [clock clicks -milliseconds] + for {set i 0} {$i < 100} {incr i} { + set sorted [r sort tosort LIMIT 0 10] + } + set elapsed [expr [clock clicks -milliseconds]-$start] + if {$::verbose} { + puts -nonewline "\n Average time to sort: [expr double($elapsed)/100] milliseconds " + flush stdout + } + } + + test "SORT speed, $num element list BY , 100 times" { + set start [clock clicks -milliseconds] + for {set i 0} {$i < 100} {incr i} { + set sorted [r sort tosort BY nokey LIMIT 0 10] + } + set elapsed [expr [clock clicks -milliseconds]-$start] + if {$::verbose} { + puts -nonewline "\n Average time to sort: [expr double($elapsed)/100] milliseconds " + flush stdout + } + } + } +} diff --git a/pikatests/tests/unit/type/.zset.tcl.swp b/pikatests/tests/unit/type/.zset.tcl.swp new file mode 100644 index 0000000000000000000000000000000000000000..7cdb763c51a73111bd27e0f6859ef4fce7c9f018 GIT binary patch literal 16384 zcmeI3VQd^n6~~vR&^B!X6eyKQrI+)iP2Ar3Y^Nol21t_-LK};^i3@Q}SnrL`o7>yH z?C#ljK3NoskdO)zQlSX=KoP1`_y7XFpsE$5NTpHL4^cnxA#D?+QXyL4TY(bb|7K=) zZ+C6SM)^>rUFnxQ?YxGo=T%*it2;99wZur^xs9cH(;M+c-3~@V5rn}=$F;+e zu-6tNOMwWhq2*kv)1thvKw*ImT40MYJ~mq8N<*dX^uFtlZLoeJURa>8Kw*Kx0)+(% z3ltV8EKpdWu)zPb1;X}b-X(U`M-7fz54x&nevOed_uq9 zp*x8B`Ij!Yb$O5}e@mAOU4AZ8{?APLK0TnQ{eS546L- zftRl{jAy}*!Ph|>d=z{H+yq{`)-YZI=fET27`PjJ8e9vW-)tDC!EeArU-7W@u83qmjr zc7VUV(=h%BUIkBrZ-Nux7&r>v4=!G580Wz=;52v?IA9;R0sI;F2^YY5@GI~`&R3xE@>yHUT-0m`c(Q|9J(Kj!*8JICPL^&A_$-s!&@xMom*bk;fKN-lXwg#GYLiK`WKo?2%~2yOg}?n!Qlm8pj@2MLULz|bRu_(x zieE?C9Xvt{rf-{d+oA>G2e#)@r9$Z2TM#51(GqSLkU19$pPHgaXi0>S%IaUs>My!B z{=OvLD+Wep5C}g!Ax?Enhem07aHQ5utYA*GmKL4!JXqCVqrzCaLYI2dlFf7#bbt9x zm^RKO#x!84v}$Wvs=I#C-WsAAqb{u>DyJ%?YieABc7zx9RxN~|b~A-*d8hKkK>D8Y zLdV3y(w<3npnbKzA)7B*rjK<~_e9`^a!_lGd|Wz`s)6;GNa{tjf8XSRORn(LkoC;A z%+Q*r{_w%c$>BvGf1Ne#c3QK-A2$8Q@G@dWs*f^f;6qhQ|jA#i-(fdgc>+A1WN90L%x z24Yy;I^kJigh9^@&F)&`;)S^4plEk(BjaLCD>RjjYm2tykZ;-n0-Nu9J|Wh%>>xli zCRjW@8tShW(UgXl8ZGQOJm+|3_&*G|iofd%EYBBYU4~)D)63?CTJtSTwa6=d}vr~Za@ zPp_tpD9>)c)@obDD{(ZyJma6V_9-JrJAw4t((r^iF^q7Riv$(hg<)o`^bF<1Zq;IO z7dnpVaA3i#0XYI^0=Px!5xPT=4LVLpwyT!TI)bg%HCYEr;{i8uO*gHr*5kf|N8|Wz zneHti%?jd3r*&b^AsxKl28yV8UFBdG+ZfIf1x0oA>G!ZomX-%rhdk`@+DH}z*Babe zN3pRQ{4#nX&yc4ntk&L!o5X2x$%vZc&%ypK*G|q;D$l@b8!_EFsQ}k$*UeC@elSjH z77bP(p_9XO{**a5i1nX1_RkBeNzoB~om%1e5T?{@cW~}49dnzmw}>$7`5^)n`)|~6 zDHca~cd-2X@e9J^ljXT{c0<C&H=P$Xb3|K-%cWy`OEVZ#vGZZJ}NvzL3 z#5++Cn#gmI>>#hAerPrV>X%rqw9G1V{y&Ah@ysTb|3|-Xzl_}eDezP9AovWp16&O* zAjdxseg+-{_k${U75V)4!S}!y0O$EPgTEq=|0U>xyTDek1)M?t{sedc41sgV*Uy0O zf``GE!I!{ofOGj*kheb$OmH8V1UtZ6$lYH6kANw#2iy#91aBgDe*?S@egM7(+Ti2h zz2G(E@29~NU>V#Cwt>yy8t@8o_ou-(z#+i7{GX7oKL#EGEies^fZIR`Yy%$xSAjQR z*R$Yxz&3sk6i;D+%WnY{ZIYN1gg7l>-3JuK(>TN>MLM*}5*-@?$6J)4PQFaqOTH1F zXcJUBK4*!(FDq~%KWXum->m+YOJ)(%ng)Mc>5)5`?^CIaB%E-+bvK{RW&XOIc9wn9 zZPNC=h@Ng;bay3t-C$cX)Tbr0TTUd--APG#Q^bwy6p_21F(R?SPpKhvn|7oQ14pc= zs(PNlnBA$uqC&l=AIUzJcZ+x&`Y z8V^Bw4t%?x%t4Zr;0{E3yV+^*ttcPra9$#r0jq^gEX-Ncsu#URWGMcOrc^HF8kOtz z++0c^(ITprf5Rnml)2ingw3s&LD?Cl^2r%;la*0+#&9aFSMWM(qu8h?l~GT^sMC%k z+y=5QG{qHUzbCUb*@$RY-Rv&FjnbKadhVpKz6M@fGP2gH3&7w3M^D~RY1b?rRK8SE z4raUIPUY~!v6tqV1TL zfG;I)%X7Am`=m18@y;00Tn>K9X7~m;3JkKwt>q9$_!hjgGMWhvQDv^ETAxPBW%@Yo zS40=rNGS#4wIbWY&XCtahWetL&sIn6-TyeZYx|gIhfIvVqms#z39>`Zboq@S{FgSQ#s`@9^xG)oJY;3 zq|yV^Wqjhyrn2~?V5fR-3@X6iRYSHr*bw@b4cTs{Aud2e{65zZccm19>Epx6Sl-T3 zP hashtable encoding conversion} { +# r config set hash-max-ziplist-entries 32 +# for {set j 0} {$j < 100} {incr j} { +# r del myhash +# for {set i 0} {$i < 64} {incr i} { +# r hset myhash [randomValue] [randomValue] +# } +# assert {[r object encoding myhash] eq {hashtable}} +# } +# } +} diff --git a/pikatests/tests/unit/type/list-2.tcl b/pikatests/tests/unit/type/list-2.tcl new file mode 100644 index 0000000000..bf6a055eba --- /dev/null +++ b/pikatests/tests/unit/type/list-2.tcl @@ -0,0 +1,44 @@ +start_server { + tags {"list"} + overrides { + "list-max-ziplist-value" 16 + "list-max-ziplist-entries" 256 + } +} { + source "tests/unit/type/list-common.tcl" + + foreach {type large} [array get largevalue] { + tags {"slow"} { + test "LTRIM stress testing - $type" { + set mylist {} + set startlen 32 + r del mylist + + # Start with the large value to ensure the + # right encoding is used. + r rpush mylist $large + lappend mylist $large + + for {set i 0} {$i < $startlen} {incr i} { + set str [randomInt 9223372036854775807] + r rpush mylist $str + lappend mylist $str + } + + for {set i 0} {$i < 1000} {incr i} { + set min [expr {int(rand()*$startlen)}] + set max [expr {$min+int(rand()*$startlen)}] + set mylist [lrange $mylist $min $max] + r ltrim mylist $min $max + assert_equal $mylist [r lrange mylist 0 -1] + + for {set j [r llen mylist]} {$j < $startlen} {incr j} { + set str [randomInt 9223372036854775807] + r rpush mylist $str + lappend mylist $str + } + } + } + } + } +} diff --git a/pikatests/tests/unit/type/list-3.tcl b/pikatests/tests/unit/type/list-3.tcl new file mode 100644 index 0000000000..94f9a0b797 --- /dev/null +++ b/pikatests/tests/unit/type/list-3.tcl @@ -0,0 +1,79 @@ +start_server { + tags {list ziplist} + overrides { + "list-max-ziplist-value" 200000 + "list-max-ziplist-entries" 256 + } +} { + test {Explicit regression for a list bug} { + set mylist {49376042582 {BkG2o\pIC]4YYJa9cJ4GWZalG[4tin;1D2whSkCOW`mX;SFXGyS8sedcff3fQI^tgPCC@^Nu1J6o]meM@Lko]t_jRyotK?tH[\EvWqS]b`o2OCtjg:?nUTwdjpcUm]y:pg5q24q7LlCOwQE^}} + r del l + r rpush l [lindex $mylist 0] + r rpush l [lindex $mylist 1] + assert_equal [r lindex l 0] [lindex $mylist 0] + assert_equal [r lindex l 1] [lindex $mylist 1] + } + + tags {slow} { + test {ziplist implementation: value encoding and backlink} { + if {$::accurate} {set iterations 100} else {set iterations 10} + for {set j 0} {$j < $iterations} {incr j} { + r del l + set l {} + for {set i 0} {$i < 200} {incr i} { + randpath { + set data [string repeat x [randomInt 100000]] + } { + set data [randomInt 65536] + } { + set data [randomInt 4294967296] + } { + set data [randomInt 18446744073709551616] + } { + set data -[randomInt 65536] + if {$data eq {-0}} {set data 0} + } { + set data -[randomInt 4294967296] + if {$data eq {-0}} {set data 0} + } { + set data -[randomInt 18446744073709551616] + if {$data eq {-0}} {set data 0} + } + lappend l $data + r rpush l $data + } + assert_equal [llength $l] [r llen l] + # Traverse backward + for {set i 199} {$i >= 0} {incr i -1} { + if {[lindex $l $i] ne [r lindex l $i]} { + assert_equal [lindex $l $i] [r lindex l $i] + } + } + } + } + + test {ziplist implementation: encoding stress testing} { + for {set j 0} {$j < 200} {incr j} { + r del l + set l {} + set len [randomInt 400] + for {set i 0} {$i < $len} {incr i} { + set rv [randomValue] + randpath { + lappend l $rv + r rpush l $rv + } { + set l [concat [list $rv] $l] + r lpush l $rv + } + } + assert_equal [llength $l] [r llen l] + for {set i 0} {$i < $len} {incr i} { + if {[lindex $l $i] ne [r lindex l $i]} { + assert_equal [lindex $l $i] [r lindex l $i] + } + } + } + } + } +} diff --git a/pikatests/tests/unit/type/list-common.tcl b/pikatests/tests/unit/type/list-common.tcl new file mode 100644 index 0000000000..ab45f0b31b --- /dev/null +++ b/pikatests/tests/unit/type/list-common.tcl @@ -0,0 +1,5 @@ +# We need a value larger than list-max-ziplist-value to make sure +# the list has the right encoding when it is swapped in again. +array set largevalue {} +set largevalue(ziplist) "hello" +set largevalue(linkedlist) [string repeat "hello" 4] diff --git a/pikatests/tests/unit/type/list.tcl b/pikatests/tests/unit/type/list.tcl new file mode 100644 index 0000000000..17358ae378 --- /dev/null +++ b/pikatests/tests/unit/type/list.tcl @@ -0,0 +1,896 @@ +start_server { + tags {"list"} + overrides { + "list-max-ziplist-value" 16 + "list-max-ziplist-entries" 256 + } +} { + source "tests/unit/type/list-common.tcl" + + test {LPUSH, RPUSH, LLENGTH, LINDEX, LPOP - ziplist} { + # first lpush then rpush + assert_equal 1 [r lpush myziplist1 a] + assert_equal 2 [r rpush myziplist1 b] + assert_equal 3 [r rpush myziplist1 c] + assert_equal 3 [r llen myziplist1] + assert_equal a [r lindex myziplist1 0] + assert_equal b [r lindex myziplist1 1] + assert_equal c [r lindex myziplist1 2] + assert_equal {} [r lindex myziplist2 3] + assert_equal c [r rpop myziplist1] + assert_equal a [r lpop myziplist1] +# assert_encoding ziplist myziplist1 + + # first rpush then lpush + assert_equal 1 [r rpush myziplist2 a] + assert_equal 2 [r lpush myziplist2 b] + assert_equal 3 [r lpush myziplist2 c] + assert_equal 3 [r llen myziplist2] + assert_equal c [r lindex myziplist2 0] + assert_equal b [r lindex myziplist2 1] + assert_equal a [r lindex myziplist2 2] + assert_equal {} [r lindex myziplist2 3] + assert_equal a [r rpop myziplist2] + assert_equal c [r lpop myziplist2] +# assert_encoding ziplist myziplist2 + } + + test {LPUSH, RPUSH, LLENGTH, LINDEX, LPOP - regular list} { + # first lpush then rpush + assert_equal 1 [r lpush mylist1 $largevalue(linkedlist)] +# assert_encoding linkedlist mylist1 + assert_equal 2 [r rpush mylist1 b] + assert_equal 3 [r rpush mylist1 c] + assert_equal 3 [r llen mylist1] + assert_equal $largevalue(linkedlist) [r lindex mylist1 0] + assert_equal b [r lindex mylist1 1] + assert_equal c [r lindex mylist1 2] + assert_equal {} [r lindex mylist1 3] + assert_equal c [r rpop mylist1] + assert_equal $largevalue(linkedlist) [r lpop mylist1] + + # first rpush then lpush + assert_equal 1 [r rpush mylist2 $largevalue(linkedlist)] +# assert_encoding linkedlist mylist2 + assert_equal 2 [r lpush mylist2 b] + assert_equal 3 [r lpush mylist2 c] + assert_equal 3 [r llen mylist2] + assert_equal c [r lindex mylist2 0] + assert_equal b [r lindex mylist2 1] + assert_equal $largevalue(linkedlist) [r lindex mylist2 2] + assert_equal {} [r lindex mylist2 3] + assert_equal $largevalue(linkedlist) [r rpop mylist2] + assert_equal c [r lpop mylist2] + } + + test {R/LPOP against empty list} { + r lpop non-existing-list + } {} + + test {Variadic RPUSH/LPUSH} { + r del mylist + assert_equal 4 [r lpush mylist a b c d] + assert_equal 8 [r rpush mylist 0 1 2 3] + assert_equal {d c b a 0 1 2 3} [r lrange mylist 0 -1] + } + + test {DEL a list - ziplist} { + assert_equal 1 [r del myziplist2] + assert_equal 0 [r exists myziplist2] + assert_equal 0 [r llen myziplist2] + } + + test {DEL a list - regular list} { + assert_equal 1 [r del mylist2] + assert_equal 0 [r exists mylist2] + assert_equal 0 [r llen mylist2] + } + + proc create_ziplist {key entries} { + r del $key + foreach entry $entries { r rpush $key $entry } +# assert_encoding ziplist $key + } + + proc create_linkedlist {key entries} { + r del $key + foreach entry $entries { r rpush $key $entry } +# assert_encoding linkedlist $key + } + +# foreach {type large} [array get largevalue] { +# test "BLPOP, BRPOP: single existing list - $type" { +# set rd [redis_deferring_client] +# create_$type blist "a b $large c d" +# +# $rd blpop blist 1 +# assert_equal {blist a} [$rd read] +# $rd brpop blist 1 +# assert_equal {blist d} [$rd read] +# +# $rd blpop blist 1 +# assert_equal {blist b} [$rd read] +# $rd brpop blist 1 +# assert_equal {blist c} [$rd read] +# } +# +# test "BLPOP, BRPOP: multiple existing lists - $type" { +# set rd [redis_deferring_client] +# create_$type blist1 "a $large c" +# create_$type blist2 "d $large f" +# +# $rd blpop blist1 blist2 1 +# assert_equal {blist1 a} [$rd read] +# $rd brpop blist1 blist2 1 +# assert_equal {blist1 c} [$rd read] +# assert_equal 1 [r llen blist1] +# assert_equal 3 [r llen blist2] +# +# $rd blpop blist2 blist1 1 +# assert_equal {blist2 d} [$rd read] +# $rd brpop blist2 blist1 1 +# assert_equal {blist2 f} [$rd read] +# assert_equal 1 [r llen blist1] +# assert_equal 1 [r llen blist2] +# } +# +# test "BLPOP, BRPOP: second list has an entry - $type" { +# set rd [redis_deferring_client] +# r del blist1 +# create_$type blist2 "d $large f" +# +# $rd blpop blist1 blist2 1 +# assert_equal {blist2 d} [$rd read] +# $rd brpop blist1 blist2 1 +# assert_equal {blist2 f} [$rd read] +# assert_equal 0 [r llen blist1] +# assert_equal 1 [r llen blist2] +# } +# +# test "BRPOPLPUSH - $type" { +# r del target +# +# set rd [redis_deferring_client] +# create_$type blist "a b $large c d" +# +# $rd brpoplpush blist target 1 +# assert_equal d [$rd read] +# +# assert_equal d [r rpop target] +# assert_equal "a b $large c" [r lrange blist 0 -1] +# } +# } +# +# test "BLPOP, LPUSH + DEL should not awake blocked client" { +# set rd [redis_deferring_client] +# r del list +# +# $rd blpop list 0 +# r multi +# r lpush list a +# r del list +# r exec +# r del list +# r lpush list b +# $rd read +# } {list b} +# +# test "BLPOP, LPUSH + DEL + SET should not awake blocked client" { +# set rd [redis_deferring_client] +# r del list +# +# $rd blpop list 0 +# r multi +# r lpush list a +# r del list +# r set list foo +# r exec +# r del list +# r lpush list b +# $rd read +# } {list b} +# +# test "BLPOP with same key multiple times should work (issue #801)" { +# set rd [redis_deferring_client] +# r del list1 list2 +# +# # Data arriving after the BLPOP. +# $rd blpop list1 list2 list2 list1 0 +# r lpush list1 a +# assert_equal [$rd read] {list1 a} +# $rd blpop list1 list2 list2 list1 0 +# r lpush list2 b +# assert_equal [$rd read] {list2 b} +# +# # Data already there. +# r lpush list1 a +# r lpush list2 b +# $rd blpop list1 list2 list2 list1 0 +# assert_equal [$rd read] {list1 a} +# $rd blpop list1 list2 list2 list1 0 +# assert_equal [$rd read] {list2 b} +# } +# +# test "MULTI/EXEC is isolated from the point of view of BLPOP" { +# set rd [redis_deferring_client] +# r del list +# $rd blpop list 0 +# r multi +# r lpush list a +# r lpush list b +# r lpush list c +# r exec +# $rd read +# } {list c} +# +# test "BLPOP with variadic LPUSH" { +# set rd [redis_deferring_client] +# r del blist target +# if {$::valgrind} {after 100} +# $rd blpop blist 0 +# if {$::valgrind} {after 100} +# assert_equal 2 [r lpush blist foo bar] +# if {$::valgrind} {after 100} +# assert_equal {blist bar} [$rd read] +# assert_equal foo [lindex [r lrange blist 0 -1] 0] +# } +# +# test "BRPOPLPUSH with zero timeout should block indefinitely" { +# set rd [redis_deferring_client] +# r del blist target +# $rd brpoplpush blist target 0 +# after 1000 +# r rpush blist foo +# assert_equal foo [$rd read] +# assert_equal {foo} [r lrange target 0 -1] +# } +# +# test "BRPOPLPUSH with a client BLPOPing the target list" { +# set rd [redis_deferring_client] +# set rd2 [redis_deferring_client] +# r del blist target +# $rd2 blpop target 0 +# $rd brpoplpush blist target 0 +# after 1000 +# r rpush blist foo +# assert_equal foo [$rd read] +# assert_equal {target foo} [$rd2 read] +# assert_equal 0 [r exists target] +# } +# +# test "BRPOPLPUSH with wrong source type" { +# set rd [redis_deferring_client] +# r del blist target +# r set blist nolist +# $rd brpoplpush blist target 1 +# assert_error "WRONGTYPE*" {$rd read} +# } +# +# test "BRPOPLPUSH with wrong destination type" { +# set rd [redis_deferring_client] +# r del blist target +# r set target nolist +# r lpush blist foo +# $rd brpoplpush blist target 1 +# assert_error "WRONGTYPE*" {$rd read} +# +# set rd [redis_deferring_client] +# r del blist target +# r set target nolist +# $rd brpoplpush blist target 0 +# after 1000 +# r rpush blist foo +# assert_error "WRONGTYPE*" {$rd read} +# assert_equal {foo} [r lrange blist 0 -1] +# } +# +# test "BRPOPLPUSH maintains order of elements after failure" { +# set rd [redis_deferring_client] +# r del blist target +# r set target nolist +# $rd brpoplpush blist target 0 +# r rpush blist a b c +# assert_error "WRONGTYPE*" {$rd read} +# r lrange blist 0 -1 +# } {a b c} +# +# test "BRPOPLPUSH with multiple blocked clients" { +# set rd1 [redis_deferring_client] +# set rd2 [redis_deferring_client] +# r del blist target1 target2 +# r set target1 nolist +# $rd1 brpoplpush blist target1 0 +# $rd2 brpoplpush blist target2 0 +# r lpush blist foo +# +# assert_error "WRONGTYPE*" {$rd1 read} +# assert_equal {foo} [$rd2 read] +# assert_equal {foo} [r lrange target2 0 -1] +# } +# +# test "Linked BRPOPLPUSH" { +# set rd1 [redis_deferring_client] +# set rd2 [redis_deferring_client] +# +# r del list1 list2 list3 +# +# $rd1 brpoplpush list1 list2 0 +# $rd2 brpoplpush list2 list3 0 +# +# r rpush list1 foo +# +# assert_equal {} [r lrange list1 0 -1] +# assert_equal {} [r lrange list2 0 -1] +# assert_equal {foo} [r lrange list3 0 -1] +# } +# +# test "Circular BRPOPLPUSH" { +# set rd1 [redis_deferring_client] +# set rd2 [redis_deferring_client] +# +# r del list1 list2 +# +# $rd1 brpoplpush list1 list2 0 +# $rd2 brpoplpush list2 list1 0 +# +# r rpush list1 foo +# +# assert_equal {foo} [r lrange list1 0 -1] +# assert_equal {} [r lrange list2 0 -1] +# } +# +# test "Self-referential BRPOPLPUSH" { +# set rd [redis_deferring_client] +# +# r del blist +# +# $rd brpoplpush blist blist 0 +# +# r rpush blist foo +# +# assert_equal {foo} [r lrange blist 0 -1] +# } +# +# test "BRPOPLPUSH inside a transaction" { +# r del xlist target +# r lpush xlist foo +# r lpush xlist bar +# +# r multi +# r brpoplpush xlist target 0 +# r brpoplpush xlist target 0 +# r brpoplpush xlist target 0 +# r lrange xlist 0 -1 +# r lrange target 0 -1 +# r exec +# } {foo bar {} {} {bar foo}} +# +# test "PUSH resulting from BRPOPLPUSH affect WATCH" { +# set blocked_client [redis_deferring_client] +# set watching_client [redis_deferring_client] +# r del srclist dstlist somekey +# r set somekey somevalue +# $blocked_client brpoplpush srclist dstlist 0 +# $watching_client watch dstlist +# $watching_client read +# $watching_client multi +# $watching_client read +# $watching_client get somekey +# $watching_client read +# r lpush srclist element +# $watching_client exec +# $watching_client read +# } {} +# +# test "BRPOPLPUSH does not affect WATCH while still blocked" { +# set blocked_client [redis_deferring_client] +# set watching_client [redis_deferring_client] +# r del srclist dstlist somekey +# r set somekey somevalue +# $blocked_client brpoplpush srclist dstlist 0 +# $watching_client watch dstlist +# $watching_client read +# $watching_client multi +# $watching_client read +# $watching_client get somekey +# $watching_client read +# $watching_client exec +# # Blocked BLPOPLPUSH may create problems, unblock it. +# r lpush srclist element +# $watching_client read +# } {somevalue} +# +# test {BRPOPLPUSH timeout} { +# set rd [redis_deferring_client] +# +# $rd brpoplpush foo_list bar_list 1 +# after 2000 +# $rd read +# } {} +# +# test "BLPOP when new key is moved into place" { +# set rd [redis_deferring_client] +# +# $rd blpop foo 5 +# r lpush bob abc def hij +# r rename bob foo +# $rd read +# } {foo hij} +# +# test "BLPOP when result key is created by SORT..STORE" { +# set rd [redis_deferring_client] +# +# # zero out list from previous test without explicit delete +# r lpop foo +# r lpop foo +# r lpop foo +# +# $rd blpop foo 5 +# r lpush notfoo hello hola aguacate konichiwa zanzibar +# r sort notfoo ALPHA store foo +# $rd read +# } {foo aguacate} +# +# foreach {pop} {BLPOP BRPOP} { +# test "$pop: with single empty list argument" { +# set rd [redis_deferring_client] +# r del blist1 +# $rd $pop blist1 1 +# r rpush blist1 foo +# assert_equal {blist1 foo} [$rd read] +# assert_equal 0 [r exists blist1] +# } +# +# test "$pop: with negative timeout" { +# set rd [redis_deferring_client] +# $rd $pop blist1 -1 +# assert_error "ERR*is negative*" {$rd read} +# } +# +# test "$pop: with non-integer timeout" { +# set rd [redis_deferring_client] +# $rd $pop blist1 1.1 +# assert_error "ERR*not an integer*" {$rd read} +# } +# +# test "$pop: with zero timeout should block indefinitely" { +# # To test this, use a timeout of 0 and wait a second. +# # The blocking pop should still be waiting for a push. +# set rd [redis_deferring_client] +# $rd $pop blist1 0 +# after 1000 +# r rpush blist1 foo +# assert_equal {blist1 foo} [$rd read] +# } +# +# test "$pop: second argument is not a list" { +# set rd [redis_deferring_client] +# r del blist1 blist2 +# r set blist2 nolist +# $rd $pop blist1 blist2 1 +# assert_error "WRONGTYPE*" {$rd read} +# } +# +# test "$pop: timeout" { +# set rd [redis_deferring_client] +# r del blist1 blist2 +# $rd $pop blist1 blist2 1 +# assert_equal {} [$rd read] +# } +# +# test "$pop: arguments are empty" { +# set rd [redis_deferring_client] +# r del blist1 blist2 +# +# $rd $pop blist1 blist2 1 +# r rpush blist1 foo +# assert_equal {blist1 foo} [$rd read] +# assert_equal 0 [r exists blist1] +# assert_equal 0 [r exists blist2] +# +# $rd $pop blist1 blist2 1 +# r rpush blist2 foo +# assert_equal {blist2 foo} [$rd read] +# assert_equal 0 [r exists blist1] +# assert_equal 0 [r exists blist2] +# } +# } +# +# test {BLPOP inside a transaction} { +# r del xlist +# r lpush xlist foo +# r lpush xlist bar +# r multi +# r blpop xlist 0 +# r blpop xlist 0 +# r blpop xlist 0 +# r exec +# } {{xlist bar} {xlist foo} {}} + + test {LPUSHX, RPUSHX - generic} { + r del xlist + assert_equal 0 [r lpushx xlist a] + assert_equal 0 [r llen xlist] + assert_equal 0 [r rpushx xlist a] + assert_equal 0 [r llen xlist] + } + + foreach {type large} [array get largevalue] { + test "LPUSHX, RPUSHX - $type" { + create_$type xlist "$large c" + assert_equal 3 [r rpushx xlist d] + assert_equal 4 [r lpushx xlist a] + assert_equal "a $large c d" [r lrange xlist 0 -1] + } + + test "LINSERT - $type" { + create_$type xlist "a $large c d" + assert_equal 5 [r linsert xlist before c zz] + assert_equal "a $large zz c d" [r lrange xlist 0 10] + assert_equal 6 [r linsert xlist after c yy] + assert_equal "a $large zz c yy d" [r lrange xlist 0 10] + assert_equal 7 [r linsert xlist after d dd] + assert_equal -1 [r linsert xlist after bad ddd] + assert_equal "a $large zz c yy d dd" [r lrange xlist 0 10] + assert_equal 8 [r linsert xlist before a aa] + assert_equal -1 [r linsert xlist before bad aaa] + assert_equal "aa a $large zz c yy d dd" [r lrange xlist 0 10] + + # check inserting integer encoded value + assert_equal 9 [r linsert xlist before aa 42] + assert_equal 42 [r lrange xlist 0 0] + } + } + + test {LINSERT raise error on bad syntax} { + catch {[r linsert xlist aft3r aa 42]} e + set e + } {*ERR*syntax*error*} + +# test {LPUSHX, RPUSHX convert from ziplist to list} { +# set large $largevalue(linkedlist) +# +# # convert when a large value is pushed +# create_ziplist xlist a +# assert_equal 2 [r rpushx xlist $large] +# assert_encoding linkedlist xlist +# create_ziplist xlist a +# assert_equal 2 [r lpushx xlist $large] +# assert_encoding linkedlist xlist +# +# # convert when the length threshold is exceeded +# create_ziplist xlist [lrepeat 256 a] +# assert_equal 257 [r rpushx xlist b] +# assert_encoding linkedlist xlist +# create_ziplist xlist [lrepeat 256 a] +# assert_equal 257 [r lpushx xlist b] +# assert_encoding linkedlist xlist +# } + +# test {LINSERT convert from ziplist to list} { +# set large $largevalue(linkedlist) +# +# # convert when a large value is inserted +# create_ziplist xlist a +# assert_equal 2 [r linsert xlist before a $large] +# assert_encoding linkedlist xlist +# create_ziplist xlist a +# assert_equal 2 [r linsert xlist after a $large] +# assert_encoding linkedlist xlist +# +# # convert when the length threshold is exceeded +# create_ziplist xlist [lrepeat 256 a] +# assert_equal 257 [r linsert xlist before a a] +# assert_encoding linkedlist xlist +# create_ziplist xlist [lrepeat 256 a] +# assert_equal 257 [r linsert xlist after a a] +# assert_encoding linkedlist xlist +# +# # don't convert when the value could not be inserted +# create_ziplist xlist [lrepeat 256 a] +# assert_equal -1 [r linsert xlist before foo a] +# assert_encoding ziplist xlist +# create_ziplist xlist [lrepeat 256 a] +# assert_equal -1 [r linsert xlist after foo a] +# assert_encoding ziplist xlist +# } + + foreach {type num} {ziplist 250 linkedlist 500} { + proc check_numbered_list_consistency {key} { + set len [r llen $key] + for {set i 0} {$i < $len} {incr i} { + assert_equal $i [r lindex $key $i] + assert_equal [expr $len-1-$i] [r lindex $key [expr (-$i)-1]] + } + } + + proc check_random_access_consistency {key} { + set len [r llen $key] + for {set i 0} {$i < $len} {incr i} { + set rint [expr int(rand()*$len)] + assert_equal $rint [r lindex $key $rint] + assert_equal [expr $len-1-$rint] [r lindex $key [expr (-$rint)-1]] + } + } + + test "LINDEX consistency test - $type" { + r del mylist + for {set i 0} {$i < $num} {incr i} { + r rpush mylist $i + } +# assert_encoding $type mylist + check_numbered_list_consistency mylist + } + + test "LINDEX random access - $type" { +# assert_encoding $type mylist + check_random_access_consistency mylist + } + +# test "Check if list is still ok after a DEBUG RELOAD - $type" { +# r debug reload +# assert_encoding $type mylist +# check_numbered_list_consistency mylist +# check_random_access_consistency mylist +# } + } + +# test {LLEN against non-list value error} { +# r del mylist +# r set mylist foobar +# assert_error WRONGTYPE* {r llen mylist} +# } + + test {LLEN against non existing key} { + assert_equal 0 [r llen not-a-key] + } + +# test {LINDEX against non-list value error} { +# assert_error WRONGTYPE* {r lindex mylist 0} +# } + + test {LINDEX against non existing key} { + assert_equal "" [r lindex not-a-key 10] + } + +# test {LPUSH against non-list value error} { +# assert_error WRONGTYPE* {r lpush mylist 0} +# } + +# test {RPUSH against non-list value error} { +# assert_error WRONGTYPE* {r rpush mylist 0} +# } + + foreach {type large} [array get largevalue] { + test "RPOPLPUSH base case - $type" { + r del mylist1 mylist2 + create_$type mylist1 "a $large c d" + assert_equal d [r rpoplpush mylist1 mylist2] + assert_equal c [r rpoplpush mylist1 mylist2] + assert_equal "a $large" [r lrange mylist1 0 -1] + assert_equal "c d" [r lrange mylist2 0 -1] +# assert_encoding ziplist mylist2 + } + + test "RPOPLPUSH with the same list as src and dst - $type" { + create_$type mylist "a $large c" + assert_equal "a $large c" [r lrange mylist 0 -1] + assert_equal c [r rpoplpush mylist mylist] + assert_equal "c a $large" [r lrange mylist 0 -1] + } + + foreach {othertype otherlarge} [array get largevalue] { + test "RPOPLPUSH with $type source and existing target $othertype" { + create_$type srclist "a b c $large" + create_$othertype dstlist "$otherlarge" + assert_equal $large [r rpoplpush srclist dstlist] + assert_equal c [r rpoplpush srclist dstlist] + assert_equal "a b" [r lrange srclist 0 -1] + assert_equal "c $large $otherlarge" [r lrange dstlist 0 -1] + + # When we rpoplpush'ed a large value, dstlist should be + # converted to the same encoding as srclist. +# if {$type eq "linkedlist"} { +# assert_encoding linkedlist dstlist +# } + } + } + } + + test {RPOPLPUSH against non existing key} { + r del srclist dstlist + assert_equal {} [r rpoplpush srclist dstlist] + assert_equal 0 [r exists srclist] + assert_equal 0 [r exists dstlist] + } + + test {RPOPLPUSH against non list src key} { + r del srclist dstlist + r set srclist x +# assert_error WRONGTYPE* {r rpoplpush srclist dstlist} +# assert_type string srclist + assert_equal 0 [r exists newlist] + } + + test {RPOPLPUSH against non list dst key} { + create_ziplist srclist {a b c d} + r set dstlist x +# assert_error WRONGTYPE* {r rpoplpush srclist dstlist} +# assert_type string dstlist + assert_equal {a b c d} [r lrange srclist 0 -1] + } + + test {RPOPLPUSH against non existing src key} { + r del srclist dstlist + assert_equal {} [r rpoplpush srclist dstlist] + } {} + + foreach {type large} [array get largevalue] { + test "Basic LPOP/RPOP - $type" { + create_$type mylist "$large 1 2" + assert_equal $large [r lpop mylist] + assert_equal 2 [r rpop mylist] + assert_equal 1 [r lpop mylist] + assert_equal 0 [r llen mylist] + + # pop on empty list + assert_equal {} [r lpop mylist] + assert_equal {} [r rpop mylist] + } + } + +# test {LPOP/RPOP against non list value} { +# r set notalist foo +# assert_error WRONGTYPE* {r lpop notalist} +# assert_error WRONGTYPE* {r rpop notalist} +# } + + foreach {type num} {ziplist 250 linkedlist 500} { + test "Mass RPOP/LPOP - $type" { + r del mylist + set sum1 0 + for {set i 0} {$i < $num} {incr i} { + r lpush mylist $i + incr sum1 $i + } +# assert_encoding $type mylist + set sum2 0 + for {set i 0} {$i < [expr $num/2]} {incr i} { + incr sum2 [r lpop mylist] + incr sum2 [r rpop mylist] + } + assert_equal $sum1 $sum2 + } + } + + foreach {type large} [array get largevalue] { + test "LRANGE basics - $type" { + create_$type mylist "$large 1 2 3 4 5 6 7 8 9" + assert_equal {1 2 3 4 5 6 7 8} [r lrange mylist 1 -2] + assert_equal {7 8 9} [r lrange mylist -3 -1] + assert_equal {4} [r lrange mylist 4 4] + } + + test "LRANGE inverted indexes - $type" { + create_$type mylist "$large 1 2 3 4 5 6 7 8 9" + assert_equal {} [r lrange mylist 6 2] + } + + test "LRANGE out of range indexes including the full list - $type" { + create_$type mylist "$large 1 2 3" + assert_equal "$large 1 2 3" [r lrange mylist -1000 1000] + } + + test "LRANGE out of range negative end index - $type" { + create_$type mylist "$large 1 2 3" + assert_equal $large [r lrange mylist 0 -4] + assert_equal {} [r lrange mylist 0 -5] + } + } + + test {LRANGE against non existing key} { + assert_equal {} [r lrange nosuchkey 0 1] + } + + foreach {type large} [array get largevalue] { + proc trim_list {type min max} { + upvar 1 large large + r del mylist + create_$type mylist "1 2 3 4 $large" + r ltrim mylist $min $max + r lrange mylist 0 -1 + } + + test "LTRIM basics - $type" { + assert_equal "1" [trim_list $type 0 0] + assert_equal "1 2" [trim_list $type 0 1] + assert_equal "1 2 3" [trim_list $type 0 2] + assert_equal "2 3" [trim_list $type 1 2] + assert_equal "2 3 4 $large" [trim_list $type 1 -1] + assert_equal "2 3 4" [trim_list $type 1 -2] + assert_equal "4 $large" [trim_list $type -2 -1] + assert_equal "$large" [trim_list $type -1 -1] + assert_equal "1 2 3 4 $large" [trim_list $type -5 -1] + assert_equal "1 2 3 4 $large" [trim_list $type -10 10] + assert_equal "1 2 3 4 $large" [trim_list $type 0 5] + assert_equal "1 2 3 4 $large" [trim_list $type 0 10] + } + + test "LTRIM out of range negative end index - $type" { + assert_equal {1} [trim_list $type 0 -5] + assert_equal {} [trim_list $type 0 -6] + } + + } + + foreach {type large} [array get largevalue] { + test "LSET - $type" { + create_$type mylist "99 98 $large 96 95" + r lset mylist 1 foo + r lset mylist -1 bar + assert_equal "99 foo $large 96 bar" [r lrange mylist 0 -1] + } + + test "LSET out of range index - $type" { + assert_error ERR*range* {r lset mylist 10 foo} + } + } + + test {LSET against non existing key} { + assert_error ERR*key* {r lset nosuchkey 10 foo} + } + +# test {LSET against non list value} { +# r set nolist foobar +# assert_error WRONGTYPE* {r lset nolist 0 foo} +# } + + foreach {type e} [array get largevalue] { + test "LREM remove all the occurrences - $type" { + create_$type mylist "$e foo bar foobar foobared zap bar test foo" + assert_equal 2 [r lrem mylist 0 bar] + assert_equal "$e foo foobar foobared zap test foo" [r lrange mylist 0 -1] + } + + test "LREM remove the first occurrence - $type" { + assert_equal 1 [r lrem mylist 1 foo] + assert_equal "$e foobar foobared zap test foo" [r lrange mylist 0 -1] + } + + test "LREM remove non existing element - $type" { + assert_equal 0 [r lrem mylist 1 nosuchelement] + assert_equal "$e foobar foobared zap test foo" [r lrange mylist 0 -1] + } + + test "LREM starting from tail with negative count - $type" { + create_$type mylist "$e foo bar foobar foobared zap bar test foo foo" + assert_equal 1 [r lrem mylist -1 bar] + assert_equal "$e foo bar foobar foobared zap test foo foo" [r lrange mylist 0 -1] + } + + test "LREM starting from tail with negative count (2) - $type" { + assert_equal 2 [r lrem mylist -2 foo] + assert_equal "$e foo bar foobar foobared zap test" [r lrange mylist 0 -1] + } + + test "LREM deleting objects that may be int encoded - $type" { + create_$type myotherlist "$e 1 2 3" + assert_equal 1 [r lrem myotherlist 1 2] + assert_equal 3 [r llen myotherlist] + } + } + + test "Regression for bug 593 - chaining BRPOPLPUSH with other blocking cmds" { + set rd1 [redis_deferring_client] + set rd2 [redis_deferring_client] + + $rd1 brpoplpush a b 0 + $rd1 brpoplpush a b 0 + $rd2 brpoplpush b c 0 + after 1000 + r lpush a data + $rd1 close + $rd2 close + r ping + } {PONG} +} diff --git a/pikatests/tests/unit/type/set.tcl b/pikatests/tests/unit/type/set.tcl new file mode 100644 index 0000000000..de3c493a9c --- /dev/null +++ b/pikatests/tests/unit/type/set.tcl @@ -0,0 +1,531 @@ +start_server { + tags {"set"} + overrides { + "set-max-intset-entries" 512 + } +} { + proc create_set {key entries} { + r del $key + foreach entry $entries { r sadd $key $entry } + } + + test {SADD, SCARD, SISMEMBER, SMEMBERS basics - regular set} { + create_set myset {foo} +# assert_encoding hashtable myset + assert_equal 1 [r sadd myset bar] + assert_equal 0 [r sadd myset bar] + assert_equal 2 [r scard myset] + assert_equal 1 [r sismember myset foo] + assert_equal 1 [r sismember myset bar] + assert_equal 0 [r sismember myset bla] + assert_equal {bar foo} [lsort [r smembers myset]] + } + + test {SADD, SCARD, SISMEMBER, SMEMBERS basics - intset} { + create_set myset {17} +# assert_encoding intset myset + assert_equal 1 [r sadd myset 16] + assert_equal 0 [r sadd myset 16] + assert_equal 2 [r scard myset] + assert_equal 1 [r sismember myset 16] + assert_equal 1 [r sismember myset 17] + assert_equal 0 [r sismember myset 18] + assert_equal {16 17} [lsort [r smembers myset]] + } + +# test {SADD against non set} { +# r lpush mylist foo +# assert_error WRONGTYPE* {r sadd mylist bar} +# } + + test "SADD a non-integer against an intset" { + create_set myset {1 2 3} +# assert_encoding intset myset + assert_equal 1 [r sadd myset a] +# assert_encoding hashtable myset + } + + test "SADD an integer larger than 64 bits" { + create_set myset {213244124402402314402033402} +# assert_encoding hashtable myset + assert_equal 1 [r sismember myset 213244124402402314402033402] + } + + test "SADD overflows the maximum allowed integers in an intset" { + r del myset + for {set i 0} {$i < 512} {incr i} { r sadd myset $i } +# assert_encoding intset myset + assert_equal 1 [r sadd myset 512] +# assert_encoding hashtable myset + } + + test {Variadic SADD} { + r del myset + assert_equal 3 [r sadd myset a b c] + assert_equal 2 [r sadd myset A a b c B] + assert_equal [lsort {A a b c B}] [lsort [r smembers myset]] + } + +# test "Set encoding after DEBUG RELOAD" { +# r del myintset myhashset mylargeintset +# for {set i 0} {$i < 100} {incr i} { r sadd myintset $i } +# for {set i 0} {$i < 1280} {incr i} { r sadd mylargeintset $i } +# for {set i 0} {$i < 256} {incr i} { r sadd myhashset [format "i%03d" $i] } +# assert_encoding intset myintset +# assert_encoding hashtable mylargeintset +# assert_encoding hashtable myhashset +# +# r debug reload +# assert_encoding intset myintset +# assert_encoding hashtable mylargeintset +# assert_encoding hashtable myhashset +# } + + test {SREM basics - regular set} { + create_set myset {foo bar ciao} +# assert_encoding hashtable myset + assert_equal 0 [r srem myset qux] + assert_equal 1 [r srem myset foo] + assert_equal {bar ciao} [lsort [r smembers myset]] + } + + test {SREM basics - intset} { + create_set myset {3 4 5} +# assert_encoding intset myset + assert_equal 0 [r srem myset 6] + assert_equal 1 [r srem myset 4] + assert_equal {3 5} [lsort [r smembers myset]] + } + + test {SREM with multiple arguments} { + r del myset + r sadd myset a b c d + assert_equal 0 [r srem myset k k k] + assert_equal 2 [r srem myset b d x y] + lsort [r smembers myset] + } {a c} + + test {SREM variadic version with more args needed to destroy the key} { + r del myset + r sadd myset 1 2 3 + r srem myset 1 2 3 4 5 6 7 8 + } {3} + + foreach {type} {hashtable intset} { + for {set i 1} {$i <= 5} {incr i} { + r del [format "set%d" $i] + } + for {set i 0} {$i < 200} {incr i} { + r sadd set1 $i + r sadd set2 [expr $i+195] + } + foreach i {199 195 1000 2000} { + r sadd set3 $i + } + for {set i 5} {$i < 200} {incr i} { + r sadd set4 $i + } + r sadd set5 0 + + # To make sure the sets are encoded as the type we are testing -- also + # when the VM is enabled and the values may be swapped in and out + # while the tests are running -- an extra element is added to every + # set that determines its encoding. + set large 200 + if {$type eq "hashtable"} { + set large foo + } + + for {set i 1} {$i <= 5} {incr i} { + r sadd [format "set%d" $i] $large + } + +# test "Generated sets must be encoded as $type" { +# for {set i 1} {$i <= 5} {incr i} { +# assert_encoding $type [format "set%d" $i] +# } +# } + + test "SINTER with two sets - $type" { + assert_equal [list 195 196 197 198 199 $large] [lsort [r sinter set1 set2]] + } + + test "SINTERSTORE with two sets - $type" { + r sinterstore setres set1 set2 +# assert_encoding $type setres + assert_equal [list 195 196 197 198 199 $large] [lsort [r smembers setres]] + } + +# test "SINTERSTORE with two sets, after a DEBUG RELOAD - $type" { +# r debug reload +# r sinterstore setres set1 set2 +# assert_encoding $type setres +# assert_equal [list 195 196 197 198 199 $large] [lsort [r smembers setres]] +# } + + test "SUNION with two sets - $type" { + set expected [lsort -uniq "[r smembers set1] [r smembers set2]"] + assert_equal $expected [lsort [r sunion set1 set2]] + } + + test "SUNIONSTORE with two sets - $type" { + r sunionstore setres set1 set2 +# assert_encoding $type setres + set expected [lsort -uniq "[r smembers set1] [r smembers set2]"] + assert_equal $expected [lsort [r smembers setres]] + } + + test "SINTER against three sets - $type" { + assert_equal [list 195 199 $large] [lsort [r sinter set1 set2 set3]] + } + + test "SINTERSTORE with three sets - $type" { + r sinterstore setres set1 set2 set3 + assert_equal [list 195 199 $large] [lsort [r smembers setres]] + } + + test "SUNION with non existing keys - $type" { + set expected [lsort -uniq "[r smembers set1] [r smembers set2]"] + assert_equal $expected [lsort [r sunion nokey1 set1 set2 nokey2]] + } + + test "SDIFF with two sets - $type" { + assert_equal {0 1 2 3 4} [lsort [r sdiff set1 set4]] + } + + test "SDIFF with three sets - $type" { + assert_equal {1 2 3 4} [lsort [r sdiff set1 set4 set5]] + } + + test "SDIFFSTORE with three sets - $type" { + r sdiffstore setres set1 set4 set5 + # When we start with intsets, we should always end with intsets. +# if {$type eq {intset}} { +# assert_encoding intset setres +# } + assert_equal {1 2 3 4} [lsort [r smembers setres]] + } + } + + test "SDIFF with first set empty" { + r del set1 set2 set3 + r sadd set2 1 2 3 4 + r sadd set3 a b c d + r sdiff set1 set2 set3 + } {} + + test "SDIFF with same set two times" { + r del set1 + r sadd set1 a b c 1 2 3 4 5 6 + r sdiff set1 set1 + } {} + + test "SDIFF fuzzing" { + for {set j 0} {$j < 100} {incr j} { + unset -nocomplain s + array set s {} + set args {} + set num_sets [expr {[randomInt 10]+1}] + for {set i 0} {$i < $num_sets} {incr i} { + set num_elements [randomInt 100] + r del set_$i + lappend args set_$i + while {$num_elements} { + set ele [randomValue] + r sadd set_$i $ele + if {$i == 0} { + set s($ele) x + } else { + unset -nocomplain s($ele) + } + incr num_elements -1 + } + } + set result [lsort [r sdiff {*}$args]] + assert_equal $result [lsort [array names s]] + } + } + +# test "SINTER against non-set should throw error" { +# r set key1 x +# assert_error "WRONGTYPE*" {r sinter key1 noset} +# } + +# test "SUNION against non-set should throw error" { +# r set key1 x +# assert_error "WRONGTYPE*" {r sunion key1 noset} +# } + + test "SINTER should handle non existing key as empty" { + r del set1 set2 set3 + r sadd set1 a b c + r sadd set2 b c d + r sinter set1 set2 set3 + } {} + + test "SINTER with same integer elements but different encoding" { + r del set1 set2 + r sadd set1 1 2 3 + r sadd set2 1 2 3 a + r srem set2 a +# assert_encoding intset set1 +# assert_encoding hashtable set2 + lsort [r sinter set1 set2] + } {1 2 3} + + test "SINTERSTORE against non existing keys should delete dstkey" { + r set setres xxx + assert_equal 0 [r sinterstore setres foo111 bar222] +# assert_equal 0 [r exists setres] + } + + test "SUNIONSTORE against non existing keys should delete dstkey" { + r set setres xxx + assert_equal 0 [r sunionstore setres foo111 bar222] +# assert_equal 0 [r exists setres] + } + + foreach {type contents} {hashtable {a b c} intset {1 2 3}} { + test "SPOP basics - $type" { + create_set myset $contents +# assert_encoding $type myset + assert_equal $contents [lsort [list [r spop myset] [r spop myset] [r spop myset]]] + assert_equal 0 [r scard myset] + } + + test "SRANDMEMBER - $type" { + create_set myset $contents + unset -nocomplain myset + array set myset {} + for {set i 0} {$i < 100} {incr i} { + set myset([r srandmember myset]) 1 + } + assert_equal $contents [lsort [array names myset]] + } + } + + test "SRANDMEMBER with against non existing key" { + r srandmember nonexisting_key 100 + } {} + + foreach {type contents} { + hashtable { + 1 5 10 50 125 50000 33959417 4775547 65434162 + 12098459 427716 483706 2726473884 72615637475 + MARY PATRICIA LINDA BARBARA ELIZABETH JENNIFER MARIA + SUSAN MARGARET DOROTHY LISA NANCY KAREN BETTY HELEN + SANDRA DONNA CAROL RUTH SHARON MICHELLE LAURA SARAH + KIMBERLY DEBORAH JESSICA SHIRLEY CYNTHIA ANGELA MELISSA + BRENDA AMY ANNA REBECCA VIRGINIA KATHLEEN + } + intset { + 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 + 20 21 22 23 24 25 26 27 28 29 + 30 31 32 33 34 35 36 37 38 39 + 40 41 42 43 44 45 46 47 48 49 + } + } { + test "SRANDMEMBER with - $type" { + create_set myset $contents + unset -nocomplain myset + array set myset {} + foreach ele [r smembers myset] { + set myset($ele) 1 + } + assert_equal [lsort $contents] [lsort [array names myset]] + + # Make sure that a count of 0 is handled correctly. + assert_equal [r srandmember myset 0] {} + + # We'll stress different parts of the code, see the implementation + # of SRANDMEMBER for more information, but basically there are + # four different code paths. + # + # PATH 1: Use negative count. + # + # 1) Check that it returns repeated elements. + set res [r srandmember myset -100] + assert_equal [llength $res] 100 + + # 2) Check that all the elements actually belong to the + # original set. + foreach ele $res { + assert {[info exists myset($ele)]} + } + + # 3) Check that eventually all the elements are returned. + unset -nocomplain auxset + set iterations 1000 + while {$iterations != 0} { + incr iterations -1 + set res [r srandmember myset -10] + foreach ele $res { + set auxset($ele) 1 + } + if {[lsort [array names myset]] eq + [lsort [array names auxset]]} { + break; + } + } + assert {$iterations != 0} + + # PATH 2: positive count (unique behavior) with requested size + # equal or greater than set size. + foreach size {50 100} { + set res [r srandmember myset $size] + assert_equal [llength $res] 50 + assert_equal [lsort $res] [lsort [array names myset]] + } + + # PATH 3: Ask almost as elements as there are in the set. + # In this case the implementation will duplicate the original + # set and will remove random elements up to the requested size. + # + # PATH 4: Ask a number of elements definitely smaller than + # the set size. + # + # We can test both the code paths just changing the size but + # using the same code. + + foreach size {45 5} { + set res [r srandmember myset $size] + assert_equal [llength $res] $size + + # 1) Check that all the elements actually belong to the + # original set. + foreach ele $res { + assert {[info exists myset($ele)]} + } + + # 2) Check that eventually all the elements are returned. + unset -nocomplain auxset + set iterations 1000 + while {$iterations != 0} { + incr iterations -1 + set res [r srandmember myset -10] + foreach ele $res { + set auxset($ele) 1 + } + if {[lsort [array names myset]] eq + [lsort [array names auxset]]} { + break; + } + } + assert {$iterations != 0} + } + } + } + + proc setup_move {} { + r del myset3 myset4 + create_set myset1 {1 a b} + create_set myset2 {2 3 4} +# assert_encoding hashtable myset1 +# assert_encoding intset myset2 + } + + test "SMOVE basics - from regular set to intset" { + # move a non-integer element to an intset should convert encoding + setup_move + assert_equal 1 [r smove myset1 myset2 a] + assert_equal {1 b} [lsort [r smembers myset1]] + assert_equal {2 3 4 a} [lsort [r smembers myset2]] +# assert_encoding hashtable myset2 + + # move an integer element should not convert the encoding + setup_move + assert_equal 1 [r smove myset1 myset2 1] + assert_equal {a b} [lsort [r smembers myset1]] + assert_equal {1 2 3 4} [lsort [r smembers myset2]] +# assert_encoding intset myset2 + } + + test "SMOVE basics - from intset to regular set" { + setup_move + assert_equal 1 [r smove myset2 myset1 2] + assert_equal {1 2 a b} [lsort [r smembers myset1]] + assert_equal {3 4} [lsort [r smembers myset2]] + } + + test "SMOVE non existing key" { + setup_move + assert_equal 0 [r smove myset1 myset2 foo] + assert_equal {1 a b} [lsort [r smembers myset1]] + assert_equal {2 3 4} [lsort [r smembers myset2]] + } + + test "SMOVE non existing src set" { + setup_move + assert_equal 0 [r smove noset myset2 foo] + assert_equal {2 3 4} [lsort [r smembers myset2]] + } + + test "SMOVE from regular set to non existing destination set" { + setup_move + assert_equal 1 [r smove myset1 myset3 a] + assert_equal {1 b} [lsort [r smembers myset1]] + assert_equal {a} [lsort [r smembers myset3]] +# assert_encoding hashtable myset3 + } + + test "SMOVE from intset to non existing destination set" { + setup_move + assert_equal 1 [r smove myset2 myset3 2] + assert_equal {3 4} [lsort [r smembers myset2]] + assert_equal {2} [lsort [r smembers myset3]] +# assert_encoding intset myset3 + } + +# test "SMOVE wrong src key type" { +# r set x 10 +# assert_error "WRONGTYPE*" {r smove x myset2 foo} +# } + +# test "SMOVE wrong dst key type" { +# r set x 10 +# assert_error "WRONGTYPE*" {r smove myset2 x foo} +# } + + test "SMOVE with identical source and destination" { + r del set + r sadd set a b c + r smove set set b + lsort [r smembers set] + } {a b c} + + tags {slow} { + test {intsets implementation stress testing} { + for {set j 0} {$j < 20} {incr j} { + unset -nocomplain s + array set s {} + r del s + set len [randomInt 1024] + for {set i 0} {$i < $len} {incr i} { + randpath { + set data [randomInt 65536] + } { + set data [randomInt 4294967296] + } { + set data [randomInt 18446744073709551616] + } + set s($data) {} + r sadd s $data + } + assert_equal [lsort [r smembers s]] [lsort [array names s]] + set len [array size s] + for {set i 0} {$i < $len} {incr i} { + set e [r spop s] + if {![info exists s($e)]} { + puts "Can't find '$e' on local array" + puts "Local array: [lsort [r smembers s]]" + puts "Remote array: [lsort [array names s]]" + error "exception" + } + array unset s $e + } + assert_equal [r scard s] 0 + assert_equal [array size s] 0 + } + } + } +} diff --git a/pikatests/tests/unit/type/zset.tcl b/pikatests/tests/unit/type/zset.tcl new file mode 100644 index 0000000000..de8fe4ae52 --- /dev/null +++ b/pikatests/tests/unit/type/zset.tcl @@ -0,0 +1,944 @@ +start_server {tags {"zset"}} { + proc create_zset {key items} { + r del $key + foreach {score entry} $items { + r zadd $key $score $entry + } + } + + proc basics {encoding} { + #if {$encoding == "ziplist"} { + # r config set zset-max-ziplist-entries 128 + # r config set zset-max-ziplist-value 64 + #} elseif {$encoding == "skiplist"} { + # r config set zset-max-ziplist-entries 0 + # r config set zset-max-ziplist-value 0 + #} else { + # puts "Unknown sorted set encoding" + # exit + #} + + test "Check encoding - $encoding" { + r del ztmp + r zadd ztmp 10 x + #assert_encoding $encoding ztmp + } + + test "ZSET basic ZADD and score update - $encoding" { + r del ztmp + r zadd ztmp 10 x + r zadd ztmp 20 y + r zadd ztmp 30 z + assert_equal {x y z} [r zrange ztmp 0 -1] + + r zadd ztmp 1 y + assert_equal {y x z} [r zrange ztmp 0 -1] + } + + test "ZSET element can't be set to NaN with ZADD - $encoding" { + assert_error "*not*float*" {r zadd myzset abcde abc} + } + + test "ZSET element can't be set to NaN with ZINCRBY" { + assert_error "*not*float*" {r zadd myzset abcde abc} + } + + test "ZINCRBY calls leading to NaN result in error" { + r zincrby myzset 999999999 abc + assert_error "*not*float*" {r zincrby myzset abcde abc} + } + + test {ZADD - Variadic version base case} { + r del myzset + list [r zadd myzset 10 a 20 b 30 c] [r zrange myzset 0 -1 withscores] + } {3 {a 10 b 20 c 30}} + + test {ZADD - Return value is the number of actually added items} { + list [r zadd myzset 5 x 20 b 30 c] [r zrange myzset 0 -1 withscores] + } {1 {x 5 a 10 b 20 c 30}} + + test {ZADD - Variadic version does not add nothing on single parsing err} { + r del myzset + catch {r zadd myzset 10 a 20 b 30.badscore c} e + assert_match {*ERR*not*float*} $e + #r exists myzset + } + + test {ZADD - Variadic version will raise error on missing arg} { + r del myzset + catch {r zadd myzset 10 a 20 b 30 c 40} e + assert_match {*ERR*syntax*} $e + } + + test {ZINCRBY does not work variadic even if shares ZADD implementation} { + r del myzset + catch {r zincrby myzset 10 a 20 b 30 c} e + assert_match {*ERR*wrong*number*arg*} $e + } + + test "ZCARD basics - $encoding" { + assert_equal 3 [r zcard ztmp] + assert_equal 0 [r zcard zdoesntexist] + } + + test "ZREM removes key after last element is removed" { + r del ztmp + r zadd ztmp 10 x + r zadd ztmp 20 y + + #assert_equal 1 [r exists ztmp] + assert_equal 0 [r zrem ztmp z] + assert_equal 1 [r zrem ztmp y] + assert_equal 1 [r zrem ztmp x] + #assert_equal 0 [r exists ztmp] + } + + test "ZREM variadic version" { + r del ztmp + r zadd ztmp 10 a 20 b 30 c + assert_equal 2 [r zrem ztmp x y a b k] + assert_equal 0 [r zrem ztmp foo bar] + assert_equal 1 [r zrem ztmp c] + #assert_equal 0 [r exists ztmp] + } + + test "ZREM variadic version -- remove elements after key deletion" { + r del ztmp + r zadd ztmp 10 a 20 b 30 c + r zrem ztmp a b c d e f g + } {3} + + test "ZRANGE basics - $encoding" { + r del ztmp + r zadd ztmp 1 a + r zadd ztmp 2 b + r zadd ztmp 3 c + r zadd ztmp 4 d + + assert_equal {a b c d} [r zrange ztmp 0 -1] + assert_equal {a b c} [r zrange ztmp 0 -2] + assert_equal {b c d} [r zrange ztmp 1 -1] + assert_equal {b c} [r zrange ztmp 1 -2] + assert_equal {c d} [r zrange ztmp -2 -1] + assert_equal {c} [r zrange ztmp -2 -2] + + # out of range start index + assert_equal {a b c} [r zrange ztmp -5 2] + assert_equal {a b} [r zrange ztmp -5 1] + assert_equal {} [r zrange ztmp 5 -1] + assert_equal {} [r zrange ztmp 5 -2] + + # out of range end index + assert_equal {a b c d} [r zrange ztmp 0 5] + assert_equal {b c d} [r zrange ztmp 1 5] + assert_equal {} [r zrange ztmp 0 -5] + assert_equal {} [r zrange ztmp 1 -5] + + # withscores + assert_equal {a 1 b 2 c 3 d 4} [r zrange ztmp 0 -1 withscores] + } + + test "ZREVRANGE basics - $encoding" { + r del ztmp + r zadd ztmp 1 a + r zadd ztmp 2 b + r zadd ztmp 3 c + r zadd ztmp 4 d + + assert_equal {d c b a} [r zrevrange ztmp 0 -1] + assert_equal {d c b} [r zrevrange ztmp 0 -2] + assert_equal {c b a} [r zrevrange ztmp 1 -1] + assert_equal {c b} [r zrevrange ztmp 1 -2] + assert_equal {b a} [r zrevrange ztmp -2 -1] + assert_equal {b} [r zrevrange ztmp -2 -2] + + # out of range start index + assert_equal {d c b} [r zrevrange ztmp -5 2] + assert_equal {d c} [r zrevrange ztmp -5 1] + assert_equal {} [r zrevrange ztmp 5 -1] + assert_equal {} [r zrevrange ztmp 5 -2] + + # out of range end index + assert_equal {d c b a} [r zrevrange ztmp 0 5] + assert_equal {c b a} [r zrevrange ztmp 1 5] + assert_equal {} [r zrevrange ztmp 0 -5] + assert_equal {} [r zrevrange ztmp 1 -5] + + ## withscores + assert_equal {d 4 c 3 b 2 a 1} [r zrevrange ztmp 0 -1 withscores] + } + + test "ZRANK/ZREVRANK basics - $encoding" { + r del zranktmp + r zadd zranktmp 10 x + r zadd zranktmp 20 y + r zadd zranktmp 30 z + assert_equal 0 [r zrank zranktmp x] + assert_equal 1 [r zrank zranktmp y] + assert_equal 2 [r zrank zranktmp z] + assert_equal "" [r zrank zranktmp foo] + assert_equal 2 [r zrevrank zranktmp x] + assert_equal 1 [r zrevrank zranktmp y] + assert_equal 0 [r zrevrank zranktmp z] + assert_equal "" [r zrevrank zranktmp foo] + } + + test "ZRANK - after deletion - $encoding" { + r zrem zranktmp y + assert_equal 0 [r zrank zranktmp x] + assert_equal 1 [r zrank zranktmp z] + } + + test "ZINCRBY - can create a new sorted set - $encoding" { + r del zset + r zincrby zset 1 foo + assert_equal {foo} [r zrange zset 0 -1] + assert_equal 1 [r zscore zset foo] + } + + test "ZINCRBY - increment and decrement - $encoding" { + r zincrby zset 2 foo + r zincrby zset 1 bar + assert_equal {bar foo} [r zrange zset 0 -1] + + r zincrby zset 10 bar + r zincrby zset -5 foo + r zincrby zset -5 bar + assert_equal {foo bar} [r zrange zset 0 -1] + + assert_equal -2 [r zscore zset foo] + assert_equal 6 [r zscore zset bar] + } + + proc create_default_zset {} { + create_zset zset {-999999999 a 1 b 2 c 3 d 4 e 5 f 999999999 g} + } + + test "ZRANGEBYSCORE/ZREVRANGEBYSCORE/ZCOUNT basics" { + create_default_zset + + # inclusive range + assert_equal {a b c} [r zrangebyscore zset -999999999 2] + assert_equal {b c d} [r zrangebyscore zset 0 3] + assert_equal {d e f} [r zrangebyscore zset 3 6] + assert_equal {e f g} [r zrangebyscore zset 4 999999999] + assert_equal {c b a} [r zrevrangebyscore zset 2 -999999999] + assert_equal {d c b} [r zrevrangebyscore zset 3 0] + assert_equal {f e d} [r zrevrangebyscore zset 6 3] + assert_equal {g f e} [r zrevrangebyscore zset 999999999 4] + assert_equal 3 [r zcount zset 0 3] + + # exclusive range + assert_equal {b} [r zrangebyscore zset (-999999999 (2] + assert_equal {b c} [r zrangebyscore zset (0 (3] + assert_equal {e f} [r zrangebyscore zset (3 (6] + assert_equal {f} [r zrangebyscore zset (4 (999999999] + assert_equal {b} [r zrevrangebyscore zset (2 (-999999999] + assert_equal {c b} [r zrevrangebyscore zset (3 (0] + assert_equal {f e} [r zrevrangebyscore zset (6 (3] + assert_equal {f} [r zrevrangebyscore zset (999999999 (4] + assert_equal 2 [r zcount zset (0 (3] + + # test empty ranges + r zrem zset a + r zrem zset g + + # inclusive + assert_equal {} [r zrangebyscore zset 4 2] + assert_equal {} [r zrangebyscore zset 6 999999999] + assert_equal {} [r zrangebyscore zset -999999999 -6] + assert_equal {} [r zrevrangebyscore zset 999999999 6] + assert_equal {} [r zrevrangebyscore zset -6 -999999999] + + # exclusive + assert_equal {} [r zrangebyscore zset (4 (2] + assert_equal {} [r zrangebyscore zset 2 (2] + assert_equal {} [r zrangebyscore zset (2 2] + assert_equal {} [r zrangebyscore zset (6 (999999999] + assert_equal {} [r zrangebyscore zset (-999999999 (-6] + assert_equal {} [r zrevrangebyscore zset (999999999 (6] + assert_equal {} [r zrevrangebyscore zset (-6 (-999999999] + + # empty inner range + assert_equal {} [r zrangebyscore zset 2.4 2.6] + assert_equal {} [r zrangebyscore zset (2.4 2.6] + assert_equal {} [r zrangebyscore zset 2.4 (2.6] + assert_equal {} [r zrangebyscore zset (2.4 (2.6] + } + + test "ZRANGEBYSCORE with WITHSCORES" { + create_default_zset + assert_equal {b 1 c 2 d 3} [r zrangebyscore zset 0 3 withscores] + assert_equal {d 3 c 2 b 1} [r zrevrangebyscore zset 3 0 withscores] + } + + test "ZRANGEBYSCORE with LIMIT" { + create_default_zset + assert_equal {b c} [r zrangebyscore zset 0 10 LIMIT 0 2] + assert_equal {d e f} [r zrangebyscore zset 0 10 LIMIT 2 3] + assert_equal {d e f} [r zrangebyscore zset 0 10 LIMIT 2 10] + assert_equal {} [r zrangebyscore zset 0 10 LIMIT 20 10] + assert_equal {f e} [r zrevrangebyscore zset 10 0 LIMIT 0 2] + assert_equal {d c b} [r zrevrangebyscore zset 10 0 LIMIT 2 3] + assert_equal {d c b} [r zrevrangebyscore zset 10 0 LIMIT 2 10] + assert_equal {} [r zrevrangebyscore zset 10 0 LIMIT 20 10] + } + + test "ZRANGEBYSCORE with LIMIT and WITHSCORES" { + create_default_zset + assert_equal {e 4 f 5} [r zrangebyscore zset 2 5 LIMIT 2 3 WITHSCORES] + assert_equal {d 3 c 2} [r zrevrangebyscore zset 5 2 LIMIT 2 3 WITHSCORES] + } + + test "ZRANGEBYSCORE with non-value min or max" { + assert_error "*not*float*" {r zrangebyscore fooz str 1} + assert_error "*not*float*" {r zrangebyscore fooz 1 str} + assert_error "*not*float*" {r zrangebyscore fooz 1 abcde} + } + + proc create_default_lex_zset {} { + create_zset zset {0 alpha 0 bar 0 cool 0 down + 0 elephant 0 foo 0 great 0 hill + 0 omega} + } + + test "ZRANGEBYLEX/ZREVRANGEBYLEX/ZCOUNT basics" { + create_default_lex_zset + + # inclusive range + assert_equal {alpha bar cool} [r zrangebylex zset - \[cool] + assert_equal {bar cool down} [r zrangebylex zset \[bar \[down] + assert_equal {great hill omega} [r zrangebylex zset \[g +] + assert_equal {cool bar alpha} [r zrevrangebylex zset \[cool -] + assert_equal {down cool bar} [r zrevrangebylex zset \[down \[bar] + assert_equal {omega hill great foo elephant down} [r zrevrangebylex zset + \[d] + assert_equal 3 [r zlexcount zset \[ele \[h] + + # exclusive range + assert_equal {alpha bar} [r zrangebylex zset - (cool] + assert_equal {cool} [r zrangebylex zset (bar (down] + assert_equal {hill omega} [r zrangebylex zset (great +] + assert_equal {bar alpha} [r zrevrangebylex zset (cool -] + assert_equal {cool} [r zrevrangebylex zset (down (bar] + assert_equal {omega hill} [r zrevrangebylex zset + (great] + assert_equal 2 [r zlexcount zset (ele (great] + + # inclusive and exclusive + assert_equal {} [r zrangebylex zset (az (b] + assert_equal {} [r zrangebylex zset (z +] + assert_equal {} [r zrangebylex zset - \[aaaa] + assert_equal {} [r zrevrangebylex zset \[elez \[elex] + assert_equal {} [r zrevrangebylex zset (hill (omega] + } + + test "ZRANGEBYSLEX with LIMIT" { + create_default_lex_zset + assert_equal {alpha bar} [r zrangebylex zset - \[cool LIMIT 0 2] + assert_equal {bar cool} [r zrangebylex zset - \[cool LIMIT 1 2] + assert_equal {} [r zrangebylex zset \[bar \[down LIMIT 0 0] + assert_equal {} [r zrangebylex zset \[bar \[down LIMIT 2 0] + assert_equal {bar} [r zrangebylex zset \[bar \[down LIMIT 0 1] + assert_equal {cool} [r zrangebylex zset \[bar \[down LIMIT 1 1] + assert_equal {bar cool down} [r zrangebylex zset \[bar \[down LIMIT 0 100] + assert_equal {omega hill great foo elephant} [r zrevrangebylex zset + \[d LIMIT 0 5] + assert_equal {omega hill great foo} [r zrevrangebylex zset + \[d LIMIT 0 4] + } + + test "ZRANGEBYLEX with invalid lex range specifiers" { + assert_error "*not*string*" {r zrangebylex fooz foo bar} + assert_error "*not*string*" {r zrangebylex fooz \[foo bar} + assert_error "*not*string*" {r zrangebylex fooz foo \[bar} + assert_error "*not*string*" {r zrangebylex fooz +x \[bar} + assert_error "*not*string*" {r zrangebylex fooz -x \[bar} + } + + test "ZREMRANGEBYSCORE basics" { + proc remrangebyscore {min max} { + create_zset zset {1 a 2 b 3 c 4 d 5 e} + #assert_equal 1 [r exists zset] + r zremrangebyscore zset $min $max + } + + # inner range + assert_equal 3 [remrangebyscore 2 4] + assert_equal {a e} [r zrange zset 0 -1] + + # start underflow + assert_equal 1 [remrangebyscore -10 1] + assert_equal {b c d e} [r zrange zset 0 -1] + + # end overflow + assert_equal 1 [remrangebyscore 5 10] + assert_equal {a b c d} [r zrange zset 0 -1] + + # switch min and max + assert_equal 0 [remrangebyscore 4 2] + assert_equal {a b c d e} [r zrange zset 0 -1] + + # -999999999 to mid + assert_equal 3 [remrangebyscore -999999999 3] + assert_equal {d e} [r zrange zset 0 -1] + + # mid to 999999999 + assert_equal 3 [remrangebyscore 3 999999999] + assert_equal {a b} [r zrange zset 0 -1] + + # -999999999 to 999999999 + assert_equal 5 [remrangebyscore -999999999 999999999] + assert_equal {} [r zrange zset 0 -1] + + # exclusive min + assert_equal 4 [remrangebyscore (1 5] + assert_equal {a} [r zrange zset 0 -1] + assert_equal 3 [remrangebyscore (2 5] + assert_equal {a b} [r zrange zset 0 -1] + + # exclusive max + assert_equal 4 [remrangebyscore 1 (5] + assert_equal {e} [r zrange zset 0 -1] + assert_equal 3 [remrangebyscore 1 (4] + assert_equal {d e} [r zrange zset 0 -1] + + # exclusive min and max + assert_equal 3 [remrangebyscore (1 (5] + assert_equal {a e} [r zrange zset 0 -1] + + # destroy when empty + assert_equal 5 [remrangebyscore 1 5] + # assert_equal 0 [r exists zset] + } + + test "ZREMRANGEBYSCORE with non-value min or max" { + assert_error "*not*float*" {r zremrangebyscore fooz str 1} + assert_error "*not*float*" {r zremrangebyscore fooz 1 str} + assert_error "*not*float*" {r zremrangebyscore fooz 1 abcde} + } + + test "ZREMRANGEBYRANK basics" { + proc remrangebyrank {min max} { + create_zset zset {1 a 2 b 3 c 4 d 5 e} + #assert_equal 1 [r exists zset] + r zremrangebyrank zset $min $max + } + + # inner range + assert_equal 3 [remrangebyrank 1 3] + assert_equal {a e} [r zrange zset 0 -1] + + # start underflow + assert_equal 1 [remrangebyrank -10 0] + assert_equal {b c d e} [r zrange zset 0 -1] + + # start overflow + assert_equal 0 [remrangebyrank 10 -1] + assert_equal {a b c d e} [r zrange zset 0 -1] + + # end underflow + assert_equal 0 [remrangebyrank 0 -10] + assert_equal {a b c d e} [r zrange zset 0 -1] + + # end overflow + assert_equal 5 [remrangebyrank 0 10] + assert_equal {} [r zrange zset 0 -1] + + # destroy when empty + assert_equal 5 [remrangebyrank 0 4] + #assert_equal 0 [r exists zset] + } + + test "ZUNIONSTORE against non-existing key doesn't set destination - $encoding" { + r del zseta + assert_equal 0 [r zunionstore dst_key 1 zseta] + #assert_equal 0 [r exists dst_key] + } + + test "ZUNIONSTORE with empty set - $encoding" { + r del zseta zsetb + r zadd zseta 1 a + r zadd zseta 2 b + r zunionstore zsetc 2 zseta zsetb + r zrange zsetc 0 -1 withscores + } {a 1 b 2} + + test "ZUNIONSTORE basics - $encoding" { + r del zseta zsetb zsetc + r zadd zseta 1 a + r zadd zseta 2 b + r zadd zseta 3 c + r zadd zsetb 1 b + r zadd zsetb 2 c + r zadd zsetb 3 d + + assert_equal 4 [r zunionstore zsetc 2 zseta zsetb] + assert_equal {a 1 b 3 d 3 c 5} [r zrange zsetc 0 -1 withscores] + } + + test "ZUNIONSTORE with weights - $encoding" { + assert_equal 4 [r zunionstore zsetc 2 zseta zsetb weights 2 3] + assert_equal {a 2 b 7 d 9 c 12} [r zrange zsetc 0 -1 withscores] + } + + test "ZUNIONSTORE with a regular set and weights - $encoding" { + r del seta + r sadd seta a + r sadd seta b + r sadd seta c + + # assert_equal 4 [r zunionstore zsetc 2 seta zsetb weights 2 3] + # assert_equal {a 2 b 5 c 8 d 9} [r zrange zsetc 0 -1 withscores] + } + + test "ZUNIONSTORE with AGGREGATE MIN - $encoding" { + assert_equal 4 [r zunionstore zsetc 2 zseta zsetb aggregate min] + assert_equal {a 1 b 1 c 2 d 3} [r zrange zsetc 0 -1 withscores] + } + + test "ZUNIONSTORE with AGGREGATE MAX - $encoding" { + assert_equal 4 [r zunionstore zsetc 2 zseta zsetb aggregate max] + assert_equal {a 1 b 2 c 3 d 3} [r zrange zsetc 0 -1 withscores] + } + + test "ZINTERSTORE basics - $encoding" { + assert_equal 2 [r zinterstore zsetc 2 zseta zsetb] + assert_equal {b 3 c 5} [r zrange zsetc 0 -1 withscores] + } + + test "ZINTERSTORE with weights - $encoding" { + assert_equal 2 [r zinterstore zsetc 2 zseta zsetb weights 2 3] + assert_equal {b 7 c 12} [r zrange zsetc 0 -1 withscores] + } + + test "ZINTERSTORE with a regular set and weights - $encoding" { + r del seta + r sadd seta a + r sadd seta b + r sadd seta c + # assert_equal 2 [r zinterstore zsetc 2 seta zsetb weights 2 3] + # assert_equal {b 5 c 8} [r zrange zsetc 0 -1 withscores] + } + + test "ZINTERSTORE with AGGREGATE MIN - $encoding" { + assert_equal 2 [r zinterstore zsetc 2 zseta zsetb aggregate min] + assert_equal {b 1 c 2} [r zrange zsetc 0 -1 withscores] + } + + test "ZINTERSTORE with AGGREGATE MAX - $encoding" { + assert_equal 2 [r zinterstore zsetc 2 zseta zsetb aggregate max] + assert_equal {b 2 c 3} [r zrange zsetc 0 -1 withscores] + } + + foreach cmd {ZUNIONSTORE ZINTERSTORE} { + # test "$cmd with 999999999/-999999999 scores - $encoding" { + # r del zsetinf1 zsetinf2 + + # r zadd zsetinf1 999999999 key + # r zadd zsetinf2 999999999 key + # r $cmd zsetinf3 2 zsetinf1 zsetinf2 + # assert_equal 999999999 [r zscore zsetinf3 key] + + # r zadd zsetinf1 -999999999 key + # r zadd zsetinf2 999999999 key + # r $cmd zsetinf3 2 zsetinf1 zsetinf2 + # assert_equal 0 [r zscore zsetinf3 key] + + # r zadd zsetinf1 999999999 key + # r zadd zsetinf2 -999999999 key + # r $cmd zsetinf3 2 zsetinf1 zsetinf2 + # assert_equal 0 [r zscore zsetinf3 key] + + # r zadd zsetinf1 -999999999 key + # r zadd zsetinf2 -999999999 key + # r $cmd zsetinf3 2 zsetinf1 zsetinf2 + # assert_equal -999999999 [r zscore zsetinf3 key] + # } + + test "$cmd with NaN weights $encoding" { + r del zsetinf1 zsetinf2 + + r zadd zsetinf1 1.0 key + r zadd zsetinf2 1.0 key + assert_error "*weight*not*float*" { + r $cmd zsetinf3 2 zsetinf1 zsetinf2 weights abcde abcde + } + } + } + } + + basics ziplist + basics skiplist + + test {ZINTERSTORE regression with two sets, intset+hashtable} { + r del seta setb setc + r sadd set1 a + r sadd set2 10 + r zinterstore set3 2 set1 set2 + } {0} + + test {ZUNIONSTORE regression, should not create NaN in scores} { + r zadd z -999999999 neginf + r zunionstore out 1 z weights 0 + r zrange out 0 -1 withscores + } {neginf 0} + + # test {ZINTERSTORE #516 regression, mixed sets and ziplist zsets} { + # r sadd one 100 101 102 103 + # r sadd two 100 200 201 202 + # r zadd three 1 500 1 501 1 502 1 503 1 100 + # r zinterstore to_here 3 one two three WEIGHTS 0 0 1 + # r zrange to_here 0 -1 + # } {100} + + test {ZUNIONSTORE result is sorted} { + # Create two sets with common and not common elements, perform + # the UNION, check that elements are still sorted. + r del one two dest + set cmd1 [list r zadd one] + set cmd2 [list r zadd two] + for {set j 0} {$j < 1000} {incr j} { + lappend cmd1 [expr rand()] [randomInt 1000] + lappend cmd2 [expr rand()] [randomInt 1000] + } + {*}$cmd1 + {*}$cmd2 + assert {[r zcard one] > 100} + assert {[r zcard two] > 100} + r zunionstore dest 2 one two + set oldscore 0 + foreach {ele score} [r zrange dest 0 -1 withscores] { + assert {$score >= $oldscore} + set oldscore $score + } + } + + proc stressers {encoding} { + if {$encoding == "ziplist"} { + # Little extra to allow proper fuzzing in the sorting stresser + #r config set zset-max-ziplist-entries 256 + #r config set zset-max-ziplist-value 64 + set elements 128 + } elseif {$encoding == "skiplist"} { + #r config set zset-max-ziplist-entries 0 + #r config set zset-max-ziplist-value 0 + if {$::accurate} {set elements 1000} else {set elements 100} + } else { + puts "Unknown sorted set encoding" + exit + } + + test "ZSCORE - $encoding" { + r del zscoretest + set aux {} + for {set i 0} {$i < $elements} {incr i} { + set score [expr rand()] + lappend aux $score + r zadd zscoretest $score $i + } + + #assert_encoding $encoding zscoretest + for {set i 0} {$i < $elements} {incr i} { + assert_equal [lindex $aux $i] [r zscore zscoretest $i] + } + } + + test "ZSCORE after a DEBUG RELOAD - $encoding" { + r del zscoretest + set aux {} + for {set i 0} {$i < $elements} {incr i} { + set score [expr rand()] + lappend aux $score + r zadd zscoretest $score $i + } + + #r debug reload + #assert_encoding $encoding zscoretest + for {set i 0} {$i < $elements} {incr i} { + assert_equal [lindex $aux $i] [r zscore zscoretest $i] + } + } + + test "ZSET sorting stresser - $encoding" { + set delta 0 + for {set test 0} {$test < 2} {incr test} { + unset -nocomplain auxarray + array set auxarray {} + set auxlist {} + r del myzset + for {set i 0} {$i < $elements} {incr i} { + if {$test == 0} { + set score [expr rand()] + } else { + set score [expr int(rand()*10)] + } + set auxarray($i) $score + r zadd myzset $score $i + # Random update + if {[expr rand()] < .2} { + set j [expr int(rand()*1000)] + if {$test == 0} { + set score [expr rand()] + } else { + set score [expr int(rand()*10)] + } + set auxarray($j) $score + r zadd myzset $score $j + } + } + foreach {item score} [array get auxarray] { + lappend auxlist [list $score $item] + } + set sorted [lsort -command zlistAlikeSort $auxlist] + set auxlist {} + foreach x $sorted { + lappend auxlist [lindex $x 1] + } + + #assert_encoding $encoding myzset + set fromredis [r zrange myzset 0 -1] + set delta 0 + for {set i 0} {$i < [llength $fromredis]} {incr i} { + if {[lindex $fromredis $i] != [lindex $auxlist $i]} { + incr delta + } + } + } + assert_equal 0 $delta + } + + test "ZRANGEBYSCORE fuzzy test, 100 ranges in $elements element sorted set - $encoding" { + set err {} + r del zset + for {set i 0} {$i < $elements} {incr i} { + r zadd zset [expr rand()] $i + } + + #assert_encoding $encoding zset + for {set i 0} {$i < 100} {incr i} { + set min [expr rand()] + set max [expr rand()] + if {$min > $max} { + set aux $min + set min $max + set max $aux + } + set low [r zrangebyscore zset -999999999 $min] + set ok [r zrangebyscore zset $min $max] + set high [r zrangebyscore zset $max 999999999] + set lowx [r zrangebyscore zset -999999999 ($min] + set okx [r zrangebyscore zset ($min ($max] + set highx [r zrangebyscore zset ($max 999999999] + + if {[r zcount zset -999999999 $min] != [llength $low]} { + append err "Error, len does not match zcount\n" + } + if {[r zcount zset $min $max] != [llength $ok]} { + append err "Error, len does not match zcount\n" + } + if {[r zcount zset $max 999999999] != [llength $high]} { + append err "Error, len does not match zcount\n" + } + if {[r zcount zset -999999999 ($min] != [llength $lowx]} { + append err "Error, len does not match zcount\n" + } + if {[r zcount zset ($min ($max] != [llength $okx]} { + append err "Error, len does not match zcount\n" + } + if {[r zcount zset ($max 999999999] != [llength $highx]} { + append err "Error, len does not match zcount\n" + } + + foreach x $low { + set score [r zscore zset $x] + if {$score > $min} { + append err "Error, score for $x is $score > $min\n" + } + } + foreach x $lowx { + set score [r zscore zset $x] + if {$score >= $min} { + append err "Error, score for $x is $score >= $min\n" + } + } + foreach x $ok { + set score [r zscore zset $x] + if {$score < $min || $score > $max} { + append err "Error, score for $x is $score outside $min-$max range\n" + } + } + foreach x $okx { + set score [r zscore zset $x] + if {$score <= $min || $score >= $max} { + append err "Error, score for $x is $score outside $min-$max open range\n" + } + } + foreach x $high { + set score [r zscore zset $x] + if {$score < $max} { + append err "Error, score for $x is $score < $max\n" + } + } + foreach x $highx { + set score [r zscore zset $x] + if {$score <= $max} { + append err "Error, score for $x is $score <= $max\n" + } + } + } + assert_equal {} $err + } + + test "ZRANGEBYLEX fuzzy test, 100 ranges in $elements element sorted set - $encoding" { + set lexset {} + r del zset + for {set j 0} {$j < $elements} {incr j} { + set e [randstring 1 30 alpha] + lappend lexset $e + r zadd zset 0 $e + } + set lexset [lsort -unique $lexset] + for {set j 0} {$j < 100} {incr j} { + set min [randstring 1 30 alpha] + set max [randstring 1 30 alpha] + set mininc [randomInt 2] + set maxinc [randomInt 2] + if {$mininc} {set cmin "\[$min"} else {set cmin "($min"} + if {$maxinc} {set cmax "\[$max"} else {set cmax "($max"} + set rev [randomInt 2] + if {$rev} { + break + set cmd zrevrangebylex + } else { + set cmd zrangebylex + } + + # Make sure data is the same in both sides + assert {[r zrange zset 0 -1] eq $lexset} + + # Get the Redis output + set output [r $cmd zset $cmin $cmax] + if {$rev} { + set outlen [r zlexcount zset $cmax $cmin] + } else { + set outlen [r zlexcount zset $cmin $cmax] + } + + # Compute the same output via Tcl + set o {} + set copy $lexset + if {(!$rev && [string compare $min $max] > 0) || + ($rev && [string compare $max $min] > 0)} { + # Empty output when ranges are inverted. + } else { + if {$rev} { + # Invert the Tcl array using Redis itself. + set copy [r zrevrange zset 0 -1] + # Invert min / max as well + lassign [list $min $max $mininc $maxinc] \ + max min maxinc mininc + } + foreach e $copy { + set mincmp [string compare $e $min] + set maxcmp [string compare $e $max] + if { + ($mininc && $mincmp >= 0 || !$mininc && $mincmp > 0) + && + ($maxinc && $maxcmp <= 0 || !$maxinc && $maxcmp < 0) + } { + lappend o $e + } + } + } + assert {$o eq $output} + assert {$outlen eq [llength $output]} + } + } + + test "ZREMRANGEBYLEX fuzzy test, 100 ranges in $elements element sorted set - $encoding" { + set lexset {} + r del zset zsetcopy + for {set j 0} {$j < $elements} {incr j} { + set e [randstring 1 30 alpha] + lappend lexset $e + r zadd zset 0 $e + } + set lexset [lsort -unique $lexset] + for {set j 0} {$j < 100} {incr j} { + # Copy... + r zunionstore zsetcopy 1 zset + set lexsetcopy $lexset + + set min [randstring 1 30 alpha] + set max [randstring 1 30 alpha] + set mininc [randomInt 2] + set maxinc [randomInt 2] + if {$mininc} {set cmin "\[$min"} else {set cmin "($min"} + if {$maxinc} {set cmax "\[$max"} else {set cmax "($max"} + + # Make sure data is the same in both sides + assert {[r zrange zset 0 -1] eq $lexset} + + # Get the range we are going to remove + set torem [r zrangebylex zset $cmin $cmax] + set toremlen [r zlexcount zset $cmin $cmax] + r zremrangebylex zsetcopy $cmin $cmax + set output [r zrange zsetcopy 0 -1] + # Remove the range with Tcl from the original list + if {$toremlen} { + set first [lsearch -exact $lexsetcopy [lindex $torem 0]] + set last [expr {$first+$toremlen-1}] + set lexsetcopy [lreplace $lexsetcopy $first+1 $last] + } + assert {$lexsetcopy eq $output} + } + } + + test "ZSETs skiplist implementation backlink consistency test - $encoding" { + set diff 0 + for {set j 0} {$j < $elements} {incr j} { + r zadd myzset [expr rand()] "Element-$j" + r zrem myzset "Element-[expr int(rand()*$elements)]" + } + + #assert_encoding $encoding myzset + set l1 [r zrange myzset 0 -1] + set l2 [r zrevrange myzset 0 -1] + for {set j 0} {$j < [llength $l1]} {incr j} { + if {[lindex $l1 $j] ne [lindex $l2 end-$j]} { + incr diff + } + } + assert_equal 0 $diff + } + + test "ZSETs ZRANK augmented skip list stress testing - $encoding" { + set err {} + r del myzset + for {set k 0} {$k < 2000} {incr k} { + set i [expr {$k % $elements}] + if {[expr rand()] < .2} { + r zrem myzset $i + } else { + set score [expr rand()] + r zadd myzset $score $i + #assert_encoding $encoding myzset + } + + set card [r zcard myzset] + if {$card > 0} { + set index [randomInt $card] + set ele [lindex [r zrange myzset $index $index] 0] + set rank [r zrank myzset $ele] + if {$rank != $index} { + set err "$ele RANK is wrong! ($rank != $index)" + break + } + } + } + assert_equal {} $err + } + } + + tags {"slow"} { + stressers ziplist + stressers skiplist + } +} diff --git a/src/pika.cc b/src/pika.cc index f5a8319ddb..8b75c7e430 100644 --- a/src/pika.cc +++ b/src/pika.cc @@ -111,7 +111,7 @@ void daemonize(void) { if ((fd = open("/dev/null", O_RDWR, 0)) != -1) { dup2(fd, STDIN_FILENO); dup2(fd, STDOUT_FILENO); - //dup2(fd, STDERR_FILENO); + dup2(fd, STDERR_FILENO); close(fd); } } diff --git a/src/pika_conf.cc b/src/pika_conf.cc index db049a0f85..83246717a7 100644 --- a/src/pika_conf.cc +++ b/src/pika_conf.cc @@ -47,8 +47,8 @@ PikaConf::PikaConf(const char* path) : if (expire_logs_days_ <= 0 ) { expire_logs_days_ = 1; } - if (expire_logs_nums_ <= 6 ) { - expire_logs_nums_ = 6; + if (expire_logs_nums_ <= 10 ) { + expire_logs_nums_ = 10; } if (root_connection_num_ < 0) { root_connection_num_ = 0; diff --git a/third/nemo b/third/nemo index 55c3586e3b..448c3e58c1 160000 --- a/third/nemo +++ b/third/nemo @@ -1 +1 @@ -Subproject commit 55c3586e3b7dce47c4ee0041e93f72bf066292dc +Subproject commit 448c3e58c1cd322f3a578af2bda459bd47763d6f