[patch] more Perl Cache::Memcached tests

[Ronald J Kimball]

Here's another patch to add tests to Perl Cache::Memcached.

02_keys.t is updated with some new tests for get_multi() and also some
comments.

04_values.t is a new file that has tests for storing/retrieving a
complex value (i.e. references and an object) and tests for incr() and
decr().

05_expires.t is a new file that has tests for expiration.  It sets a key
with an expire time of 2, sleeps for 3 seconds, then makes sure the key
is no longer present in the cache.  I'm hoping 3 seconds is not too long
to make the test wait.

Ronald

-------------- next part --------------
diff -N -r -u Cache-Memcached-1.24.b/t/02_keys.t Cache-Memcached-1.24/t/02_keys.t
--- Cache-Memcached-1.24.b/t/02_keys.t	2007-08-07 16:38:54.000000000 -0400
+++ Cache-Memcached-1.24/t/02_keys.t	2007-08-07 17:17:42.000000000 -0400
@@ -9,7 +9,7 @@
 my $msock = IO::Socket::INET->new(PeerAddr => $testaddr,
                                   Timeout  => 3);
 if ($msock) {
-    plan tests => 13;
+    plan tests => 17;
 } else {
     plan skip_all => "No memcached instance running at $testaddr\n";
     exit 0;
@@ -22,17 +22,37 @@
 
 isa_ok($memd, 'Cache::Memcached');
 
-ok($memd->set("key1", "val1"), "set key1 as val1");
 
+# test set(), get(), and add()
+ok($memd->set("key1", "val1"), "set key1 as val1");
 is($memd->get("key1"), "val1", "get key1 is val1");
 ok(! $memd->add("key1", "val-replace"), "add key1 properly failed");
+
 ok($memd->add("key2", "val2"), "add key2 as val2");
 is($memd->get("key2"), "val2", "get key2 is val2");
 
+
+# test replace()
 ok($memd->replace("key2", "val-replace"), "replace key2 as val-replace");
 is($memd->get("key2"), "val-replace", "get key2 is val-replace");
 ok(! $memd->replace("key-noexist", "bogus"), "replace key-noexist properly failed");
 
+
+# test get_multi() - returns hash for existing keys
+is_deeply($memd->get_multi(qw/ key1 key2 key-noexist /),
+          { key1 => "val1", key2 => "val-replace" },
+          "get_multi key1, key2, key-noexist");
+is_deeply($memd->get_multi(qw/ key1 key-noexist /),
+          { key1 => "val1" },
+          "get_multi key1, key-noexist");
+is_deeply($memd->get_multi(qw/ key1 key1 /),
+          { key1 => "val1" },
+          "get_multi key1, key1");
+is_deeply($memd->get_multi(qw/ key-noexist key-noexist2 /),
+          { },
+          "get_multi key-noexist, key-noexist2");
+
+# test delete()
 ok($memd->delete("key1"), "delete key1");
 ok(! $memd->get("key1"), "get key1 properly failed");
 
diff -N -r -u Cache-Memcached-1.24.b/t/04_values.t Cache-Memcached-1.24/t/04_values.t
--- Cache-Memcached-1.24.b/t/04_values.t	1969-12-31 19:00:00.000000000 -0500
+++ Cache-Memcached-1.24/t/04_values.t	2007-08-07 18:13:02.000000000 -0400
@@ -0,0 +1,57 @@
+#!/usr/bin/env perl -w
+
+use strict;
+use Test::More;
+use Cache::Memcached;
+use IO::Socket::INET;
+
+my $testaddr = "127.0.0.1:11211";
+my $msock = IO::Socket::INET->new(PeerAddr => $testaddr,
+                                  Timeout  => 3);
+if ($msock) {
+    plan tests => 16;
+} else {
+    plan skip_all => "No memcached instance running at $testaddr\n";
+    exit 0;
+}
+
+my $memd = Cache::Memcached->new({
+    servers   => [ $testaddr ],
+    namespace => "Cache::Memcached::t/$$/" . (time() % 100) . "/",
+});
+
+isa_ok($memd, 'Cache::Memcached');
+
+# test complex value
+my $object = bless { attr => 1 }, 'Cache::Memcached::t::Object';
+
+ok($memd->add('key-complex', { 'complex' => [ $object, 2, 4, undef ] }),
+   'add key-complex');
+
+my $complex_val = $memd->get('key-complex');
+is_deeply($complex_val, { 'complex' => [ $object, 2, 4, undef ] },
+          'get key-complex');
+
+# is_deeply ignores blessing; test explicitly
+isa_ok($complex_val->{'complex'}[0], 'Cache::Memcached::t::Object',
+       'get key-complex object');
+
+
+# test incr() and decr() - both return updated value
+ok($memd->add('key-incr', 0),     'add key-incr as 0');
+is($memd->get('key-incr'),     0, 'get key-incr is 0');
+
+is($memd->incr('key-incr'),    1, 'incr key-incr is 1');
+is($memd->get('key-incr'),     1, 'get key-incr is 1');
+
+is($memd->incr('key-incr', 3), 4, 'incr key-incr by 3 is 4');
+is($memd->get('key-incr'),     4, 'get key-incr is 4');
+
+is($memd->decr('key-incr'),    3, 'decr key-incr is 3');
+is($memd->get('key-incr'),     3, 'get key-incr is 3');
+
+is($memd->decr('key-incr', 2), 1, 'decr key-incr by 2 is 1');
+is($memd->get('key-incr'),     1, 'get key-incr is 1');
+
+is($memd->decr('key-incr', 2), 0, 'decr key-incr by 2 is 0 (underflow check)');
+is($memd->get('key-incr'),     0, 'get key-incr is 0 (underflow check)');
diff -N -r -u Cache-Memcached-1.24.b/t/05_expires.t Cache-Memcached-1.24/t/05_expires.t
--- Cache-Memcached-1.24.b/t/05_expires.t	1969-12-31 19:00:00.000000000 -0500
+++ Cache-Memcached-1.24/t/05_expires.t	2007-08-07 18:13:19.000000000 -0400
@@ -0,0 +1,31 @@
+#!/usr/bin/env perl -w
+
+use strict;
+use Test::More;
+use Cache::Memcached;
+use IO::Socket::INET;
+
+my $testaddr = "127.0.0.1:11211";
+my $msock = IO::Socket::INET->new(PeerAddr => $testaddr,
+                                  Timeout  => 3);
+if ($msock) {
+    plan tests => 4;
+} else {
+    plan skip_all => "No memcached instance running at $testaddr\n";
+    exit 0;
+}
+
+my $memd = Cache::Memcached->new({
+    servers   => [ $testaddr ],
+    namespace => "Cache::Memcached::t/$$/" . (time() % 100) . "/",
+});
+
+isa_ok($memd, 'Cache::Memcached');
+
+# test expiration
+ok($memd->set('key-expire', 'val', 2), 'set key-expire as val');
+is($memd->get('key-expire'), 'val', 'get key-expire is val');
+
+sleep 3;
+
+is($memd->get('key-expire'), undef, 'get key-expire is undef after expiration');