"Fossies" - the Fresh Open Source Software Archive

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


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. See also the last Fossies "Diffs" side-by-side code changes report for "stats.t": 1.6.12_vs_1.6.13.

    1 #!/usr/bin/perl
    2 
    3 use strict;
    4 use Test::More tests => 113;
    5 use FindBin qw($Bin);
    6 use lib "$Bin/lib";
    7 use MemcachedTest;
    8 
    9 my $server = new_memcached("-I 1024 -o slab_chunk_max=1024,no_lru_crawler,no_lru_maintainer");
   10 my $sock = $server->sock;
   11 
   12 
   13 ## Output looks like this:
   14 ##
   15 ## STAT pid 22969
   16 ## STAT uptime 13
   17 ## STAT time 1259170891
   18 ## STAT version 1.4.3
   19 ## STAT libevent 1.4.13-stable.
   20 ## see doc/protocol.txt for others
   21 # note that auth stats are tested in auth specific tests
   22 
   23 
   24 my $stats = mem_stats($sock);
   25 
   26 # Test number of keys
   27 if (MemcachedTest::enabled_tls_testing()) {
   28     # when TLS is enabled, stats contains additional keys:
   29     #   - ssl_handshake_errors
   30     #   - time_since_server_cert_refresh
   31     is(scalar(keys(%$stats)), 85, "expected count of stats values");
   32 } else {
   33     is(scalar(keys(%$stats)), 83, "expected count of stats values");
   34 }
   35 
   36 # Test initial state
   37 foreach my $key (qw(curr_items total_items bytes cmd_get cmd_set get_hits evictions get_misses get_expired
   38                  bytes_written delete_hits delete_misses incr_hits incr_misses decr_hits get_flushed
   39                  decr_misses listen_disabled_num lrutail_reflocked time_in_listen_disabled_us
   40                  store_too_large store_no_memory)) {
   41     is($stats->{$key}, 0, "initial $key is zero");
   42 }
   43 is($stats->{accepting_conns}, 1, "initial accepting_conns is one");
   44 
   45 # Do some operations
   46 
   47 print $sock "set foo 0 0 6\r\nfooval\r\n";
   48 is(scalar <$sock>, "STORED\r\n", "stored foo");
   49 mem_get_is($sock, "foo", "fooval");
   50 
   51 my $stats = mem_stats($sock);
   52 
   53 foreach my $key (qw(total_items curr_items cmd_get cmd_set get_hits)) {
   54     is($stats->{$key}, 1, "after one set/one get $key is 1");
   55 }
   56 
   57 my $cache_dump = mem_stats($sock, " cachedump 1 100");
   58 ok(defined $cache_dump->{'foo'}, "got foo from cachedump");
   59 
   60 print $sock "delete foo\r\n";
   61 is(scalar <$sock>, "DELETED\r\n", "deleted foo");
   62 
   63 my $stats = mem_stats($sock);
   64 is($stats->{delete_hits}, 1);
   65 is($stats->{delete_misses}, 0);
   66 
   67 print $sock "delete foo\r\n";
   68 is(scalar <$sock>, "NOT_FOUND\r\n", "shouldn't delete foo again");
   69 
   70 my $stats = mem_stats($sock);
   71 is($stats->{delete_hits}, 1);
   72 is($stats->{delete_misses}, 1);
   73 
   74 # incr stats
   75 
   76 sub check_incr_stats {
   77     my ($ih, $im, $dh, $dm) = @_;
   78     my $stats = mem_stats($sock);
   79 
   80     is($stats->{incr_hits}, $ih);
   81     is($stats->{incr_misses}, $im);
   82     is($stats->{decr_hits}, $dh);
   83     is($stats->{decr_misses}, $dm);
   84 }
   85 
   86 print $sock "incr i 1\r\n";
   87 is(scalar <$sock>, "NOT_FOUND\r\n", "shouldn't incr a missing thing");
   88 check_incr_stats(0, 1, 0, 0);
   89 
   90 print $sock "decr d 1\r\n";
   91 is(scalar <$sock>, "NOT_FOUND\r\n", "shouldn't decr a missing thing");
   92 check_incr_stats(0, 1, 0, 1);
   93 
   94 print $sock "set n 0 0 1\r\n0\r\n";
   95 is(scalar <$sock>, "STORED\r\n", "stored n");
   96 
   97 print $sock "incr n 3\r\n";
   98 is(scalar <$sock>, "3\r\n", "incr works");
   99 check_incr_stats(1, 1, 0, 1);
  100 
  101 print $sock "decr n 1\r\n";
  102 is(scalar <$sock>, "2\r\n", "decr works");
  103 check_incr_stats(1, 1, 1, 1);
  104 
  105 # cas stats
  106 
  107 sub check_cas_stats {
  108     my ($ch, $cm, $cb) = @_;
  109     my $stats = mem_stats($sock);
  110 
  111     is($stats->{cas_hits}, $ch);
  112     is($stats->{cas_misses}, $cm);
  113     is($stats->{cas_badval}, $cb);
  114 }
  115 
  116 check_cas_stats(0, 0, 0);
  117 
  118 print $sock "cas c 0 0 1 99999999\r\nz\r\n";
  119 is(scalar <$sock>, "NOT_FOUND\r\n", "missed cas");
  120 check_cas_stats(0, 1, 0);
  121 
  122 print $sock "set c 0 0 1\r\nx\r\n";
  123 is(scalar <$sock>, "STORED\r\n", "stored c");
  124 my ($id, $v) = mem_gets($sock, 'c');
  125 is('x', $v, 'got the expected value');
  126 
  127 print $sock "cas c 0 0 1 99999999\r\nz\r\n";
  128 is(scalar <$sock>, "EXISTS\r\n", "missed cas");
  129 check_cas_stats(0, 1, 1);
  130 my ($newid, $v) = mem_gets($sock, 'c');
  131 is('x', $v, 'got the expected value');
  132 
  133 print $sock "cas c 0 0 1 $id\r\nz\r\n";
  134 is(scalar <$sock>, "STORED\r\n", "good cas");
  135 check_cas_stats(1, 1, 1);
  136 my ($newid, $v) = mem_gets($sock, 'c');
  137 is('z', $v, 'got the expected value');
  138 
  139 my $settings = mem_stats($sock, ' settings');
  140 is(1024, $settings->{'maxconns'});
  141 # we run SSL tests over TCP; hence the domain_socket
  142 # is expected to be NULL.
  143 if (enabled_tls_testing() || !supports_unix_socket()) {
  144     is('NULL', $settings->{'domain_socket'});
  145 } else {
  146     isnt('NULL', $settings->{'domain_socket'});
  147 }
  148 is('on', $settings->{'evictions'});
  149 is('yes', $settings->{'cas_enabled'});
  150 is('no', $settings->{'auth_enabled_sasl'});
  151 is('no', $settings->{'shutdown_command'});
  152 
  153 print $sock "stats reset\r\n";
  154 is(scalar <$sock>, "RESET\r\n", "good stats reset");
  155 
  156 my $stats = mem_stats($sock);
  157 is(0, $stats->{'cmd_get'});
  158 is(0, $stats->{'cmd_set'});
  159 is(0, $stats->{'get_hits'});
  160 is(0, $stats->{'get_misses'});
  161 is(0, $stats->{'get_expired'});
  162 is(0, $stats->{'get_flushed'});
  163 is(0, $stats->{'delete_misses'});
  164 is(0, $stats->{'delete_hits'});
  165 is(0, $stats->{'incr_misses'});
  166 is(0, $stats->{'incr_hits'});
  167 is(0, $stats->{'decr_misses'});
  168 is(0, $stats->{'decr_hits'});
  169 is(0, $stats->{'cas_misses'});
  170 is(0, $stats->{'cas_hits'});
  171 is(0, $stats->{'cas_badval'});
  172 is(0, $stats->{'evictions'});
  173 is(0, $stats->{'reclaimed'});
  174 is(0, $stats->{'lrutail_reflocked'});
  175 
  176 # item expired
  177 print $sock "set should_expire 0 2678400 6\r\nfooval\r\n"; #2678400 = 31 days in seconds
  178 is(scalar <$sock>, "STORED\r\n", "set item to expire");
  179 print $sock "get should_expire\r\n";
  180 is(scalar <$sock>, "END\r\n", "item not returned");
  181 my $stats = mem_stats($sock);
  182 is(1, $stats->{'get_expired'}, "get_expired counter is 1");
  183 
  184 print $sock "set should_be_flushed 0 0 6\r\nbooval\r\n";
  185 is(scalar <$sock>, "STORED\r\n", "set item to flush");
  186 print $sock "flush_all\r\n";
  187 is(scalar <$sock>, "OK\r\n", "flushed");
  188 print $sock "get should_be_flushed\r\n";
  189 is(scalar <$sock>, "END\r\n", "flushed item not returned");
  190 
  191 my $stats = mem_stats($sock);
  192 is($stats->{cmd_flush}, 1, "after one flush cmd_flush is 1");
  193 is($stats->{get_flushed}, 1, "after flush and a get, get_flushed is 1");
  194 
  195 # item too large
  196 my $large = "B" x 2048;
  197 my $largelen = length($large);
  198 print $sock "set too_large 0 0 $largelen\r\n$large\r\n";
  199 is(scalar <$sock>, "SERVER_ERROR object too large for cache\r\n",
  200     "set rejected due to value too large");
  201 $stats = mem_stats($sock);
  202 is($stats->{'store_too_large'}, 1,
  203     "recorded store failure due to value too large")