generic-library/msgpack
1
0
Fork 0
mirror of https://github.com/msgpack/msgpack-c.git synced 2025-03-22 00:19:19 +01:00
Code Issues Projects Releases Wiki Activity

Perl: added failing test case for memory leaks

Browse Source
This commit is contained in:
tokuhirom 2010-05-03 00:22:16 +09:00
parent 517ced2a54
commit c77eac325e
3 changed files with 197 additions and 1 deletions

4
perl/Makefile.PL

@ -8,7 +8,7 @@ license 'perl';
can_cc or die "This module requires a C compiler"; can_cc or die "This module requires a C compiler";
tests 't/*.t'; tests 't/*.t';
author_tests('xt'); recursive_author_tests('xt');
use_ppport 3.19; use_ppport 3.19;
clean_files qw{ clean_files qw{
@ -32,6 +32,8 @@ if ($Module::Install::AUTHOR && -d File::Spec->catfile('..', 'msgpack')) {
} }
} }
requires 'Test::More' => 0.95;
auto_set_repository; auto_set_repository;
build_requires 'Test::More'; build_requires 'Test::More';
use_test_base; use_test_base;

93
perl/xt/leaks/normal.t Normal file

@ -0,0 +1,93 @@
use strict;
use warnings;
use Test::More;
use Data::MessagePack;
use Devel::Peek;
plan skip_all => '$ENV{LEAK_TEST} is required' unless $ENV{LEAK_TEST};
my $input = [
{
"ZCPGBENCH-1276933268" =>
{ "1271859210" => [ "\x14\x02\x07\x00\x00", 1 ] },
"VDORBENCH-5637665303" =>
{ "1271859210" => [ "\x00\x01\x00\x01\x00", 1 ] },
"ZVTHBENCH-7648578738" => {
"1271859210" => [
"\x0a\x02\x04\x00\x00", "2600",
"\x0a\x05\x04\x00\x00", "4600"
]
},
"VMVTBENCH-5237337637" =>
{ "1271859210" => [ "\x00\x01\x00\x01\x00", 1 ] },
"ZPLSBENCH-1823993880" =>
{ "1271859210" => [ "\x01\x07\x07\x03\x06", "10001" ] },
"ZCPGBENCH-1995524375" =>
{ "1271859210" => [ "\x14\x02\x07\x00\x00", 1 ] },
"ZCPGBENCH-2330423245" =>
{ "1271859210" => [ "\x14\x02\x07\x00\x00", 1 ] },
"ZCPGBENCH-2963065090" =>
{ "1271859210" => [ "\x14\x02\x07\x00\x00", 1 ] },
"MINT0" => { "1271859210" => [ "\x00\x01\x00\x01\x00", "D" ] }
}
];
my $r = Data::MessagePack->pack($input);
my $n1 = trace(10);
my $n2 = trace(10000);
diag("$n1, $n2");
cmp_ok abs($n2-$n1), '<', 100;
done_testing;
sub trace {
my $n = shift;
my $before = memoryusage();
for ( 1 .. $n ) {
my $x = Data::MessagePack->unpack($r);
# is_deeply($x, $input);
}
my $after = memoryusage();
diag("$n\t: $after - $before");
return $after - $before;
}
sub memoryusage {
my $status = `cat /proc/$$/status`;
my @lines = split( "\n", $status );
foreach my $line (@lines) {
if ( $line =~ /^VmRSS:/ ) {
$line =~ s/.*:\s*(\d+).*/$1/;
return int($line);
}
}
return -1;
}
__END__
[
{
"ZCPGBENCH-1276933268" =>
{ "1271859210" => [ "\x14\x02\x07\x00\x00", 1 ] },
"VDORBENCH-5637665303" =>
{ "1271859210" => [ "\x00\x01\x00\x01\x00", 1 ] },
"ZVTHBENCH-7648578738" => {
"1271859210" => [
"\x0a\x02\x04\x00\x00", "2600",
"\x0a\x05\x04\x00\x00", "4600"
]
},
"VMVTBENCH-5237337637" =>
{ "1271859210" => [ "\x00\x01\x00\x01\x00", 1 ] },
"ZPLSBENCH-1823993880" =>
{ "1271859210" => [ "\x01\x07\x07\x03\x06", "10001" ] },
"ZCPGBENCH-1995524375" =>
{ "1271859210" => [ "\x14\x02\x07\x00\x00", 1 ] },
"ZCPGBENCH-2330423245" =>
{ "1271859210" => [ "\x14\x02\x07\x00\x00", 1 ] },
"ZCPGBENCH-2963065090" =>
{ "1271859210" => [ "\x14\x02\x07\x00\x00", 1 ] },
"MINT0" => { "1271859210" => [ "\x00\x01\x00\x01\x00", "D" ] }
}
]

101
perl/xt/leaks/stream.t Normal file

@ -0,0 +1,101 @@
use strict;
use warnings;
use Test::More;
use Data::MessagePack;
use Test::Requires 'Test::LeakTrace';
use Devel::Peek;
plan skip_all => '$ENV{LEAK_TEST} is required' unless $ENV{LEAK_TEST};
my $input = [
{
"ZCPGBENCH-1276933268" =>
{ "1271859210" => [ "\x14\x02\x07\x00\x00", 1 ] },
"VDORBENCH-5637665303" =>
{ "1271859210" => [ "\x00\x01\x00\x01\x00", 1 ] },
"ZVTHBENCH-7648578738" => {
"1271859210" => [
"\x0a\x02\x04\x00\x00", "2600",
"\x0a\x05\x04\x00\x00", "4600"
]
},
"VMVTBENCH-5237337637" =>
{ "1271859210" => [ "\x00\x01\x00\x01\x00", 1 ] },
"ZPLSBENCH-1823993880" =>
{ "1271859210" => [ "\x01\x07\x07\x03\x06", "10001" ] },
"ZCPGBENCH-1995524375" =>
{ "1271859210" => [ "\x14\x02\x07\x00\x00", 1 ] },
"ZCPGBENCH-2330423245" =>
{ "1271859210" => [ "\x14\x02\x07\x00\x00", 1 ] },
"ZCPGBENCH-2963065090" =>
{ "1271859210" => [ "\x14\x02\x07\x00\x00", 1 ] },
"MINT0" => { "1271859210" => [ "\x00\x01\x00\x01\x00", "D" ] }
}
];
$input = [(undef)x10];
my $r = Data::MessagePack->pack($input);
my $n1 = trace(10);
my $n2 = trace(10000);
diag("$n1, $n2");
cmp_ok abs($n2-$n1), '<', 100;
done_testing;
sub trace {
my $n = shift;
my $before = memoryusage();
for ( 1 .. $n ) {
my $unpacker = Data::MessagePack::Unpacker->new();
$unpacker->execute($r, 0);
# ok $unpacker->is_finished if $i % 100 == 0;
if ($unpacker->is_finished) {
my $x = $unpacker->data;
# is_deeply($x, $input) if $i % 100 == 0;
}
}
my $after = memoryusage();
diag("$n\t: $after - $before");
return $after - $before;
}
sub memoryusage {
my $status = `cat /proc/$$/status`;
my @lines = split( "\n", $status );
foreach my $line (@lines) {
if ( $line =~ /^VmRSS:/ ) {
$line =~ s/.*:\s*(\d+).*/$1/;
return int($line);
}
}
return -1;
}
__END__
[
{
"ZCPGBENCH-1276933268" =>
{ "1271859210" => [ "\x14\x02\x07\x00\x00", 1 ] },
"VDORBENCH-5637665303" =>
{ "1271859210" => [ "\x00\x01\x00\x01\x00", 1 ] },
"ZVTHBENCH-7648578738" => {
"1271859210" => [
"\x0a\x02\x04\x00\x00", "2600",
"\x0a\x05\x04\x00\x00", "4600"
]
},
"VMVTBENCH-5237337637" =>
{ "1271859210" => [ "\x00\x01\x00\x01\x00", 1 ] },
"ZPLSBENCH-1823993880" =>
{ "1271859210" => [ "\x01\x07\x07\x03\x06", "10001" ] },
"ZCPGBENCH-1995524375" =>
{ "1271859210" => [ "\x14\x02\x07\x00\x00", 1 ] },
"ZCPGBENCH-2330423245" =>
{ "1271859210" => [ "\x14\x02\x07\x00\x00", 1 ] },
"ZCPGBENCH-2963065090" =>
{ "1271859210" => [ "\x14\x02\x07\x00\x00", 1 ] },
"MINT0" => { "1271859210" => [ "\x00\x01\x00\x01\x00", "D" ] }
}
]