From 517ced2a54870e1c5aa9339d2483787477e529bd Mon Sep 17 00:00:00 2001 From: tokuhirom Date: Mon, 3 May 2010 00:08:02 +0900 Subject: [PATCH 1/2] Perl: added more test case for streaming unpacker --- perl/t/06_stream_unpack2.t | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) create mode 100644 perl/t/06_stream_unpack2.t diff --git a/perl/t/06_stream_unpack2.t b/perl/t/06_stream_unpack2.t new file mode 100644 index 00000000..dc82c411 --- /dev/null +++ b/perl/t/06_stream_unpack2.t @@ -0,0 +1,26 @@ +use strict; +use warnings; +use Data::MessagePack; +use Test::More; + +my $input = [(undef)x16]; +my $packed = Data::MessagePack->pack($input); +is_deeply(Data::MessagePack->unpack($packed), $input); + +{ + my $up = Data::MessagePack::Unpacker->new(); + $up->execute($packed, 0); + ok $up->is_finished; + is_deeply $up->data, $input; +} + +{ + my $up = Data::MessagePack::Unpacker->new(); + is $up->execute(substr($packed, 0, 3), 0), 3; + $up->execute($packed, 3); + ok $up->is_finished; + is_deeply $up->data, $input; +} + +done_testing; + From c77eac325e0097987f7bfcc2f1d62913c7326f21 Mon Sep 17 00:00:00 2001 From: tokuhirom Date: Mon, 3 May 2010 00:22:16 +0900 Subject: [PATCH 2/2] Perl: added failing test case for memory leaks --- perl/Makefile.PL | 4 +- perl/xt/leaks/normal.t | 93 +++++++++++++++++++++++++++++++++++++ perl/xt/leaks/stream.t | 101 +++++++++++++++++++++++++++++++++++++++++ 3 files changed, 197 insertions(+), 1 deletion(-) create mode 100644 perl/xt/leaks/normal.t create mode 100644 perl/xt/leaks/stream.t diff --git a/perl/Makefile.PL b/perl/Makefile.PL index ac83f72c..27db3636 100644 --- a/perl/Makefile.PL +++ b/perl/Makefile.PL @@ -8,7 +8,7 @@ license 'perl'; can_cc or die "This module requires a C compiler"; tests 't/*.t'; -author_tests('xt'); +recursive_author_tests('xt'); use_ppport 3.19; clean_files qw{ @@ -32,6 +32,8 @@ if ($Module::Install::AUTHOR && -d File::Spec->catfile('..', 'msgpack')) { } } +requires 'Test::More' => 0.95; + auto_set_repository; build_requires 'Test::More'; use_test_base; diff --git a/perl/xt/leaks/normal.t b/perl/xt/leaks/normal.t new file mode 100644 index 00000000..370b23e6 --- /dev/null +++ b/perl/xt/leaks/normal.t @@ -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" ] } + } + ] + diff --git a/perl/xt/leaks/stream.t b/perl/xt/leaks/stream.t new file mode 100644 index 00000000..c196d4df --- /dev/null +++ b/perl/xt/leaks/stream.t @@ -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" ] } + } + ] +