[memcached] bradfitz, r299: adding benchmark script
commits at code.sixapart.com
commits at code.sixapart.com
Mon Jul 17 20:59:33 UTC 2006
adding benchmark script
A trunk/api/perl/dev/
A trunk/api/perl/dev/bench.pl
U trunk/api/perl/lib/Cache/Memcached.pm
Added: trunk/api/perl/dev/bench.pl
===================================================================
--- trunk/api/perl/dev/bench.pl 2006-07-06 18:50:53 UTC (rev 298)
+++ trunk/api/perl/dev/bench.pl 2006-07-17 20:59:30 UTC (rev 299)
@@ -0,0 +1,65 @@
+#!/usr/bin/perl
+
+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 => 9;
+} else {
+ plan skip_all => "No memcached instance running at $testaddr\n";
+ exit 0;
+}
+
+my $keys = 800;
+
+my $memd = Cache::Memcached->new({
+# servers => [ $testaddr, $testaddr ],
+ servers => [ $testaddr ],
+ namespace => "Cache::Memcached::t/$$/" . (time() % 100) . "/",
+});
+
+my %correct;
+for my $num (1..$keys) {
+ $correct{"key$num"} = "key$num " . ("-" x ($num * 50));
+ $memd->set("key$num", $correct{"key$num"})
+ or die "Failed to init $num";
+}
+
+srand(1);
+my $to = 3000;
+for (1..$to) {
+ warn "$_ / $to\n" if $_ % 100 == 0;
+ my @multi = map { "key$_" } map { int(rand($keys * 2)) + 1 } (1..40);
+ my $get = $memd->get_multi(@multi);
+ #use Data::Dumper;
+ #print Dumper(\@multi, $get);
+ for (0..4) { # was 4
+ my $k = $multi[$_];
+ die "no match for '$k': $get->{$k} vs $correct{$k}" unless $get->{$k} eq $correct{$k};
+ }
+}
+
+
+__END__
+
+ok($memd->set("key1", "val1"), "set succeeded");
+
+is($memd->get("key1"), "val1", "get worked");
+ok(! $memd->add("key1", "val-replace"), "add properly failed");
+ok($memd->add("key2", "val2"), "add worked on key2");
+is($memd->get("key2"), "val2", "get worked");
+
+ok($memd->replace("key2", "val-replace"), "replace worked");
+ok(! $memd->replace("key-noexist", "bogus"), "replace failed");
+
+my $stats = $memd->stats;
+ok($stats, "got stats");
+is(ref $stats, "HASH", "is a hashref");
+
+
+
Property changes on: trunk/api/perl/dev/bench.pl
___________________________________________________________________
Name: svn:executable
+ *
Modified: trunk/api/perl/lib/Cache/Memcached.pm
===================================================================
--- trunk/api/perl/lib/Cache/Memcached.pm 2006-07-06 18:50:53 UTC (rev 298)
+++ trunk/api/perl/lib/Cache/Memcached.pm 2006-07-17 20:59:30 UTC (rev 299)
@@ -693,6 +693,8 @@
SEARCH:
while(1) { # may have to search many times
+
+
# do we have a complete END line?
if ($buf{$sockstr} =~ /^END\r\n/) {
# okay, finished with this socket
@@ -725,6 +727,7 @@
last SEARCH; # buffer is empty now
}
+
# if we're here probably means we only have a partial VALUE
# or END line in the buffer. Could happen with multi-get,
# though probably very rarely. Exit the loop and let it read
@@ -783,6 +786,7 @@
$active_changed = 0;
}
# TODO: more intelligent cumulative timeout?
+ # TODO: select is interruptible w/ ptrace attach, signal, etc. should note that.
$nfound = select($rout=$rin, $wout=$win, undef,
$self->{'select_timeout'});
last unless $nfound;
More information about the memcached-commits
mailing list