new tests for EXPIRE family functions, new millisecond precision, and new millisecond...

diff --git a/tests/unit/expire.tcl b/tests/unit/expire.tcl
index 415a0f53803b2061385db3ad844d8b1cd2cc5fda..6130e8429a3d857596664201c89583108fc83338 100644 (file)
--- a/tests/unit/expire.tcl
+++ b/tests/unit/expire.tcl
@@ -5,7 +5,7 @@ start_server {tags {"expire"}} {
         set v2 [r ttl x]
         set v3 [r expire x 10]
         set v4 [r ttl x]
-        r expire x 4
+        r expire x 2
         list $v1 $v2 $v3 $v4
     } {1 [45] 1 10}
 
@@ -14,8 +14,8 @@ start_server {tags {"expire"}} {
     } {foobar}
 
     tags {"slow"} {
-        test {EXPIRE - After 6 seconds the key should no longer be here} {
-            after 6000
+        test {EXPIRE - After 2.1 seconds the key should no longer be here} {
+            after 2100
             list [r get x] [r exists x]
         } {{} 0}
     }
@@ -51,7 +51,7 @@ start_server {tags {"expire"}} {
 
     tags {"slow"} {
         test {SETEX - Wait for the key to expire} {
-            after 3000
+            after 1100
             r get y
         } {}
     }
@@ -71,4 +71,60 @@ start_server {tags {"expire"}} {
         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 997
+            set a [r get x]
+            after 1002
+            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 97
+            set a [r get x]
+            after 102
+            set b [r get x]
+
+            r set x somevalue
+            r pexpire x 100
+            after 97
+            set c [r get x]
+            after 102
+            set d [r get x]
+
+            r set x somevalue
+            r pexpireat x [expr ([clock seconds]*1000)+100]
+            after 97
+            set e [r get x]
+            after 102
+            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 {PTTL returns millisecond time to live} {
+        r del x
+        r setex x 1 somevalue
+        set ttl [r pttl x]
+        assert {$ttl > 900 && $ttl <= 1000}
+    }
 }

diff --git a/tests/unit/other.tcl b/tests/unit/other.tcl
index 702c291f9a504e832b68ac50f3385e6afa9df021..bb65570a46685388cbdf41e02aefe23ccb084ea0 100644 (file)
--- a/tests/unit/other.tcl
+++ b/tests/unit/other.tcl
@@ -107,7 +107,7 @@ start_server {tags {"other"}} {
         }
     }
 
-    test {EXPIRES after a reload (snapshot + append only file)} {
+    test {EXPIRES after a reload (snapshot + append only file rewrite)} {
         r flushdb
         r set x 10
         r expire x 1000
@@ -123,6 +123,39 @@ start_server {tags {"other"}} {
         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
+        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]