"Fossies" - the Fresh Open Source Software Archive

Member "memcached-1.6.15/t/multiversioning.t" (21 Feb 2022, 1896 Bytes) of package /linux/www/memcached-1.6.15.tar.gz:

    1 #!/usr/bin/perl
    2 
    3 use strict;
    4 use Test::More tests => 13;
    5 use FindBin qw($Bin);
    6 use lib "$Bin/lib";
    7 use MemcachedTest;
    8 
    9 my $server = new_memcached();
   10 my $sock  = $server->sock;
   11 my $sock2 = $server->new_sock;
   12 
   13 ok($sock != $sock2, "have two different connections open");
   14 
   15 # set large value
   16 my $size   = 256 * 1024;  # 256 kB
   17 my $bigval = "0123456789abcdef" x ($size / 16);
   18 $bigval =~ s/^0/\[/; $bigval =~ s/f$/\]/;
   19 my $bigval2 = uc($bigval);
   20 
   21 print $sock "set big 0 0 $size\r\n$bigval\r\n";
   22 is(scalar <$sock>, "STORED\r\n", "stored foo");
   23 mem_get_is($sock, "big", $bigval, "big value got correctly");
   24 
   25 print $sock "get big\r\n";
   26 my $buf;
   27 my $read = 0;
   28 my $to_read = $size / 2;
   29 while ($read < $to_read) {
   30     my $read_bytes = $sock->sysread($buf,
   31                         ($to_read - $read > MemcachedTest::MAX_READ_WRITE_SIZE ?
   32                                 MemcachedTest::MAX_READ_WRITE_SIZE : $to_read - $read),
   33                         $read);
   34     last if ($read_bytes <= 0);
   35     $read += $read_bytes;
   36 }
   37 is($read, $size / 2, "read half the answer back");
   38 like($buf, qr/VALUE big/, "buf has big value header in it");
   39 like($buf, qr/abcdef/, "buf has some data in it");
   40 unlike($buf, qr/abcde\]/, "buf doesn't yet close");
   41 
   42 # sock2 interrupts (maybe sock1 is slow) and deletes stuff:
   43 print $sock2 "delete big\r\n";
   44 is(scalar <$sock2>, "DELETED\r\n", "deleted big from sock2 while sock1's still reading it");
   45 mem_get_is($sock2, "big", undef, "nothing from sock2 now.  gone from namespace.");
   46 print $sock2 "set big 0 0 $size\r\n$bigval2\r\n";
   47 is(scalar <$sock2>, "STORED\r\n", "stored big w/ val2");
   48 mem_get_is($sock2, "big", $bigval2, "big value2 got correctly");
   49 
   50 # sock1 resumes reading...
   51 $buf .= <$sock>;
   52 $buf .= <$sock>;
   53 like($buf, qr/abcde\]/, "buf now closes");
   54 
   55 # and if sock1 reads again, it's the uppercase version:
   56 mem_get_is($sock, "big", $bigval2, "big value2 got correctly from sock1");