root/trunk/api/perl/t/100_flush_bug.t @ 814

Revision 814, 1.2 kB (checked in by ask, 6 months ago)

Fix occasional failure in the 100_flush_bug.t test

Line 
1#!/usr/bin/env perl -w
2
3use strict;
4use Test::More;
5use Cache::Memcached;
6use IO::Socket::INET;
7
8my $port = 11311;
9my $testaddr = "127.0.0.1:$port";
10my $sock = IO::Socket::INET->new(
11    LocalAddr => $testaddr,
12    Proto     => 'tcp',
13    ReuseAddr => 1,
14);
15
16my @res = (
17    ["OK\r\n", 1],
18    ["ERROR\r\n", 0],
19    ["\r\nERROR\r\n", 0],
20    ["FOO\r\nERROR\r\n", 0],
21    ["FOO\r\nOK\r\nERROR\r\n", 0],
22    ["\r\n\r\nOK\r\n", 0],
23    ["END\r\n", 0],
24);
25
26if ($sock) {
27    plan tests => scalar @res;
28} else {
29    plan skip_all => "cannot bind to $testaddr\n";
30    exit 0;
31}
32close $sock;
33
34my $pid = fork;
35die "Cannot fork because: '$!'" unless defined $pid;
36unless ($pid) {
37   
38    my $sock = IO::Socket::INET->new(
39        LocalAddr  => $testaddr,
40        Proto      => 'tcp',
41        ReuseAddr  => 1,
42        Listen     => 1,
43    ) or die "cannot open $testaddr: $!";
44    my $csock = $sock->accept();
45    while (defined (my $buf = <$csock>)) {
46        my $res = shift @res;
47        print $csock $res->[0];
48    }
49    close $csock;
50    close $sock;
51    exit 0;
52}
53
54# give the forked server a chance to startup
55sleep 1;
56
57my $memd = Cache::Memcached->new({ servers   => [ $testaddr ] });
58
59for (@res) {
60    ($_->[0] =~ s/\W//g);
61    is $memd->flush_all, $_->[1], $_->[0];
62}
Note: See TracBrowser for help on using the browser.