[memcached] bradfitz, r356: daemonize tests

[commits at code.sixapart.com]

daemonize tests

U   trunk/server/test/daemonize.t
U   trunk/server/test/lib/MemcachedTest.pm


Modified: trunk/server/test/daemonize.t
===================================================================
--- trunk/server/test/daemonize.t	2006-09-04 21:03:49 UTC (rev 355)
+++ trunk/server/test/daemonize.t	2006-09-04 21:04:02 UTC (rev 356)
@@ -1,11 +1,33 @@
 #!/usr/bin/perl
 
 use strict;
-use Test::More skip_all => "Tests not written.";  # tests => 1
+use Test::More tests => 7;
 use FindBin qw($Bin);
 use lib "$Bin/lib";
 use MemcachedTest;
 
-my $server = new_memcached();
+use File::Temp qw(tempfile);
+
+my (undef, $tmpfn) = tempfile();
+
+my $server = new_memcached("-d -P $tmpfn");
 my $sock = $server->sock;
+sleep 0.5;
 
+ok(-e $tmpfn, "pid file exists");
+ok(-s $tmpfn, "pid file has length");
+
+open (my $fh, $tmpfn) or die;
+my $readpid = do { local $/; <$fh>; };
+chomp $readpid;
+close ($fh);
+
+ok(kill(0, $readpid), "process is still running");
+
+my $stats = mem_stats($sock);
+is($stats->{pid}, $readpid, "memcached reports same pid as file");
+
+ok($server->new_sock, "opened new socket");
+ok(kill(9, $readpid), "sent KILL signal");
+sleep 0.5;
+ok(! $server->new_sock, "failed to open new socket");

Modified: trunk/server/test/lib/MemcachedTest.pm
===================================================================
--- trunk/server/test/lib/MemcachedTest.pm	2006-09-04 21:03:49 UTC (rev 355)
+++ trunk/server/test/lib/MemcachedTest.pm	2006-09-04 21:04:02 UTC (rev 356)
@@ -6,13 +6,27 @@
 use Carp qw(croak);
 use vars qw(@EXPORT);
 
- at EXPORT = qw(new_memcached sleep mem_get_is);
+ at EXPORT = qw(new_memcached sleep mem_get_is mem_stats);
 
 sub sleep {
     my $n = shift;
     select undef, undef, undef, $n;
 }
 
+sub mem_stats {
+    my ($sock, $type) = @_;
+    $type = $type ? " $type" : "";
+    print $sock "stats$type\r\n";
+    my $stats = {};
+    while (<$sock>) {
+        last if /^(\.|END)/;
+        /^STAT (\S+) (\d+)/;
+        #print " slabs: $_";
+        $stats->{$1} = $2;
+    }
+    return $stats;
+}
+
 sub mem_get_is {
     # works on single-line values only.  no newlines in value.
     my ($sock_opts, $key, $val, $msg) = @_;
@@ -61,7 +75,7 @@
     my $port = free_port();
     $args .= " -p $port";
     if ($< == 0) {
-	$args .= " -u root";
+        $args .= " -u root";
     }
     my $childpid = fork();