Permalink
Browse files

Lost tests/bench, I think.

git-svn-id: http://code.sixapart.com/svn/memcached/trunk/api/perl@714 b0b603af-a30f-0410-a34e-baf09ae79d0b
  • Loading branch information...
1 parent 6880d27 commit 2717b1986972c5317b1e308133c9c0379298d75a dormando committed Feb 24, 2008
Showing with 110 additions and 0 deletions.
  1. +58 −0 dev/bench_noreply.pl
  2. +52 −0 t/04_noreply.t
View
@@ -0,0 +1,58 @@
+#! /usr/bin/perl
+#
+use warnings;
+use strict;
+
+# Note: you may have to set PERL5LIB to point to the module.
+use Cache::Memcached;
+
+use FindBin;
+
+@ARGV == 1 or @ARGV == 2
+ or die "Usage: $FindBin::Script HOST:PORT [COUNT]\n";
+
+# Note that it's better to run the test over the wire, because for
+# localhost the task may become CPU bound.
+my $addr = $ARGV[0];
+my $count = $ARGV[1] || 10_000;
+
+my $memd = Cache::Memcached->new({
+ servers => [ $addr ],
+ namespace => ''
+});
+
+die "$!\n" unless $memd;
+
+
+# By running 'noreply' test first we also ensure there are no reply
+# packets left in the network.
+foreach my $noreply (1, 0) {
+ use Time::HiRes qw(gettimeofday tv_interval);
+
+ print "'noreply' is ", $noreply ? "enabled" : "disabled", ":\n";
+ my $param = $noreply ? 'noreply' : '';
+ my $res;
+
+ my $start = [gettimeofday];
+ if ($noreply) {
+ foreach (1 .. $count) {
+ $memd->add("foo", 1);
+ $memd->set("foo", 1);
+ $memd->replace("foo", 1);
+ $memd->incr("foo", 1);
+ $memd->decr("foo", 1);
+ $memd->delete("foo");
+ }
+ } else {
+ foreach (1 .. $count) {
+ $res = $memd->add("foo", 1);
+ $res = $memd->set("foo", 1);
+ $res = $memd->replace("foo", 1);
+ $res = $memd->incr("foo", 1);
+ $res = $memd->decr("foo", 1);
+ $res = $memd->delete("foo");
+ }
+ }
+ my $end = [gettimeofday];
+ printf("update methods: %.2f secs\n\n", tv_interval($start, $end));
+}
View
@@ -0,0 +1,52 @@
+#!/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 => 7;
+} 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');
+
+
+use constant count => 30;
+
+$memd->flush_all;
+
+$memd->add("key", "add");
+is($memd->get("key"), "add");
+
+for (my $i = 0; $i < count; ++$i) {
+ $memd->set("key", $i);
+}
+is($memd->get("key"), count - 1);
+
+$memd->replace("key", count);
+is($memd->get("key"), count);
+
+for (my $i = 0; $i < count; ++$i) {
+ $memd->incr("key", 2);
+}
+is($memd->get("key"), count + 2 * count);
+
+for (my $i = 0; $i < count; ++$i) {
+ $memd->decr("key", 1);
+}
+is($memd->get("key"), count + 1 * count);
+
+$memd->delete("key");
+is($memd->get("key"), undef);

0 comments on commit 2717b19

Please sign in to comment.