Perl: added failing test case for memory leaks

3 files changed, 197 insertions, 1 deletions

diff --git a/perl/Makefile.PL b/perl/Makefile.PL
index ac83f72..27db363 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 0000000..370b23e
--- /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 0000000..c196d4d
--- /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" ] }
+        }
+    ]
+