Perlのメモリリークを見つける方法

Perlではメモリリーク検出ツールがいくつか開発されているので、top(1)の結果を眺めるよりそういうツールを使うほうが楽である。
さて、メモリリークが発生しているとき、その可能性としてはだいたい以下の4つが挙げられる。

1. Perlレベルでの循環参照
2. グローバル変数に値をどんどん足しているとき*1
3. XSレベルでリファレンスカウントの管理ミス
4. XSレベルでmalloc()したメモリの管理ミス

この1-3についてはすべてPerlインタプリタ内の出来事であり、Test::LeakTraceを使って検出できる。4を検出するのは難しいが、Test::Valgrindが役に立つ。
Test::LeakTraceのSYNOPSISは歴史的経緯によりごちゃごちゃしているが、テストで使うべき関数はno_leaks_ok()とleaks_cmp_ok()だけである。
たとえば、以下のようにして使う*2。

#!perl
# Usage: perl leaktrace.pl [--weak]
use 5.14.0;
use warnings;
use Test::LeakTrace;
use Test::More;

package LinkedList {
    use Mouse;
    use MouseX::StrictConstructor;
    has next => (
        is  => 'rw',
        isa => 'Maybe[LinkedList]',
    );
    has previous => (
        is  => 'rw',
        isa => 'Maybe[LinkedList]',
        (scalar grep { $_ eq '--weak' } @ARGV)
            ? (weak_ref => 1)
            : (),
    );
    has value => (
        is => 'rw',
    );
    __PACKAGE__->meta->make_immutable();
}

my $root = LinkedList->new( value => 10 );
$root->next(  LinkedList->new( previous => $root, value => 20 ) );

say $root->dump();

no_leaks_ok {
    my $root = LinkedList->new( value => 10 );
    $root->next(  LinkedList->new( previous => $root, value => 20 ) );
};

done_testing;
__END__

出力はDevel::Peek形式でのダンプで出すのでリークする値が多いと以下のとおり非常に煩雑だが、無事にメモリリークが検出できた。またメモリリークが発生した箇所も示してくれる。これはXSが絡むと正確でない可能性があるが、Perlレベルではほぼ正確だと思う*3。

$ perl leaktrace.pl
$VAR1 = bless( {
  next => bless( {
    previous => $VAR1,
    value => 20
  }, 'LinkedList' ),
  value => 10
}, 'LinkedList' );

not ok 1 - leaks 6 <= 0
#   Failed test 'leaks 6 <= 0'
#   at leaktrace.pl line 35.
#     '6'
#         <=
#     '0'
# leaked SCALAR(0x9567280) from leaktrace.pl line 33.
#   32:no_leaks_ok {
#   33:    my $root = LinkedList->new( value => 10 );
#   34:    $root->next(  LinkedList->new( previous => $root, value => 20 ) );
# SV = IV(0x956727c) at 0x9567280
#   REFCNT = 1
#   FLAGS = (IOK,pIOK)
#   IV = 10
# leaked HASH(0x96bbe00) from leaktrace.pl line 33.
#   32:no_leaks_ok {
#   33:    my $root = LinkedList->new( value => 10 );
#   34:    $root->next(  LinkedList->new( previous => $root, value => 20 ) );
# SV = PVHV(0x963b7e0) at 0x96bbe00
#   REFCNT = 1
#   FLAGS = (OBJECT,SHAREKEYS)
#   STASH = 0x95805e8	"LinkedList"
#   ARRAY = 0x973ba68  (0:6, 1:2)
#   hash quality = 125.0%
#   KEYS = 2
#   FILL = 2
#   MAX = 7
#   RITER = -1
#   EITER = 0x0
#     Elt "next" HASH = 0x4bcd2941
#     SV = IV(0x9617dc4) at 0x9617dc8
#       REFCNT = 1
#       FLAGS = (ROK)
#       RV = 0x97282b8
#         SV = PVHV(0x963b7f0) at 0x97282b8
#           REFCNT = 1
#           FLAGS = (OBJECT,SHAREKEYS)
#           STASH = 0x95805e8	"LinkedList"
#           ARRAY = 0x9701c20  (0:6, 1:2)
#           hash quality = 125.0%
#           KEYS = 2
#           FILL = 2
#           MAX = 7
#           RITER = -1
#           EITER = 0x0
#             Elt "previous" HASH = 0x6f62f028
#             SV = IV(0x9617e84) at 0x9617e88
#               REFCNT = 1
#               FLAGS = (ROK)
#               RV = 0x96bbe00
#                 SV = PVHV(0x963b7e0) at 0x96bbe00
#                   REFCNT = 1
#                   FLAGS = (OBJECT,OOK,SHAREKEYS)
#                   STASH = 0x95805e8	"LinkedList"
#                   ARRAY = 0x9618e58  (0:6, 1:2)
#                   hash quality = 125.0%
#                   KEYS = 2
#                   FILL = 2
#                   MAX = 7
#                   RITER = 1
#                   EITER = 0x966035c
#             Elt "value" HASH = 0x1e720953
#             SV = IV(0x9728284) at 0x9728288
#               REFCNT = 1
#               FLAGS = (IOK,pIOK)
#               IV = 20
#     Elt "value" HASH = 0x1e720953
#     SV = IV(0x956727c) at 0x9567280
#       REFCNT = 1
#       FLAGS = (IOK,pIOK)
#       IV = 10
# leaked REF(0x9617e88) from leaktrace.pl line 34.
#   33:    my $root = LinkedList->new( value => 10 );
#   34:    $root->next(  LinkedList->new( previous => $root, value => 20 ) );
#   35:};
# SV = IV(0x9617e84) at 0x9617e88
#   REFCNT = 1
#   FLAGS = (ROK)
#   RV = 0x96bbe00
#     SV = PVHV(0x963b7e0) at 0x96bbe00
#       REFCNT = 1
#       FLAGS = (OBJECT,OOK,SHAREKEYS)
#       STASH = 0x95805e8	"LinkedList"
#       ARRAY = 0x9618e58  (0:6, 1:2)
#       hash quality = 125.0%
#       KEYS = 2
#       FILL = 2
#       MAX = 7
#       RITER = -1
#       EITER = 0x0
#         Elt "next" HASH = 0x4bcd2941
#         SV = IV(0x9617dc4) at 0x9617dc8
#           REFCNT = 1
#           FLAGS = (ROK)
#           RV = 0x97282b8
#             SV = PVHV(0x963b7f0) at 0x97282b8
#               REFCNT = 1
#               FLAGS = (OBJECT,OOK,SHAREKEYS)
#               STASH = 0x95805e8	"LinkedList"
#               ARRAY = 0x9702e00  (0:6, 1:2)
#               hash quality = 125.0%
#               KEYS = 2
#               FILL = 2
#               MAX = 7
#               RITER = -1
#               EITER = 0x0
#                 Elt "previous" HASH = 0x6f62f028
#                 SV = IV(0x9617e84) at 0x9617e88
#                   REFCNT = 1
#                   FLAGS = (ROK)
#                   RV = 0x96bbe00
#         Elt "value" HASH = 0x1e720953
#         SV = IV(0x956727c) at 0x9567280
#           REFCNT = 1
#           FLAGS = (IOK,pIOK)
#           IV = 10
# leaked REF(0x9617dc8) from leaktrace.pl line 34.
#   33:    my $root = LinkedList->new( value => 10 );
#   34:    $root->next(  LinkedList->new( previous => $root, value => 20 ) );
#   35:};
# SV = IV(0x9617dc4) at 0x9617dc8
#   REFCNT = 1
#   FLAGS = (ROK)
#   RV = 0x97282b8
#     SV = PVHV(0x963b7f0) at 0x97282b8
#       REFCNT = 1
#       FLAGS = (OBJECT,OOK,SHAREKEYS)
#       STASH = 0x95805e8	"LinkedList"
#       ARRAY = 0x9702e00  (0:6, 1:2)
#       hash quality = 125.0%
#       KEYS = 2
#       FILL = 2
#       MAX = 7
#       RITER = -1
#       EITER = 0x0
#         Elt "previous" HASH = 0x6f62f028
#         SV = IV(0x9617e84) at 0x9617e88
#           REFCNT = 1
#           FLAGS = (ROK)
#           RV = 0x96bbe00
#             SV = PVHV(0x963b7e0) at 0x96bbe00
#               REFCNT = 1
#               FLAGS = (OBJECT,OOK,SHAREKEYS)
#               STASH = 0x95805e8	"LinkedList"
#               ARRAY = 0x9618e58  (0:6, 1:2)
#               hash quality = 125.0%
#               KEYS = 2
#               FILL = 2
#               MAX = 7
#               RITER = -1
#               EITER = 0x0
#                 Elt "next" HASH = 0x4bcd2941
#                 SV = IV(0x9617dc4) at 0x9617dc8
#                   REFCNT = 1
#                   FLAGS = (ROK)
#                   RV = 0x97282b8
#         Elt "value" HASH = 0x1e720953
#         SV = IV(0x9728284) at 0x9728288
#           REFCNT = 1
#           FLAGS = (IOK,pIOK)
#           IV = 20
# leaked HASH(0x97282b8) from leaktrace.pl line 34.
#   33:    my $root = LinkedList->new( value => 10 );
#   34:    $root->next(  LinkedList->new( previous => $root, value => 20 ) );
#   35:};
# SV = PVHV(0x963b7f0) at 0x97282b8
#   REFCNT = 1
#   FLAGS = (OBJECT,OOK,SHAREKEYS)
#   STASH = 0x95805e8	"LinkedList"
#   ARRAY = 0x9702e00  (0:6, 1:2)
#   hash quality = 125.0%
#   KEYS = 2
#   FILL = 2
#   MAX = 7
#   RITER = -1
#   EITER = 0x0
#     Elt "previous" HASH = 0x6f62f028
#     SV = IV(0x9617e84) at 0x9617e88
#       REFCNT = 1
#       FLAGS = (ROK)
#       RV = 0x96bbe00
#         SV = PVHV(0x963b7e0) at 0x96bbe00
#           REFCNT = 1
#           FLAGS = (OBJECT,OOK,SHAREKEYS)
#           STASH = 0x95805e8	"LinkedList"
#           ARRAY = 0x9618e58  (0:6, 1:2)
#           hash quality = 125.0%
#           KEYS = 2
#           FILL = 2
#           MAX = 7
#           RITER = -1
#           EITER = 0x0
#             Elt "next" HASH = 0x4bcd2941
#             SV = IV(0x9617dc4) at 0x9617dc8
#               REFCNT = 1
#               FLAGS = (ROK)
#               RV = 0x97282b8
#                 SV = PVHV(0x963b7f0) at 0x97282b8
#                   REFCNT = 1
#                   FLAGS = (OBJECT,OOK,SHAREKEYS)
#                   STASH = 0x95805e8	"LinkedList"
#                   ARRAY = 0x9702e00  (0:6, 1:2)
#                   hash quality = 125.0%
#                   KEYS = 2
#                   FILL = 2
#                   MAX = 7
#                   RITER = 0
#                   EITER = 0x95dddfc
#             Elt "value" HASH = 0x1e720953
#             SV = IV(0x956727c) at 0x9567280
#               REFCNT = 1
#               FLAGS = (IOK,pIOK)
#               IV = 10
#     Elt "value" HASH = 0x1e720953
#     SV = IV(0x9728284) at 0x9728288
#       REFCNT = 1
#       FLAGS = (IOK,pIOK)
#       IV = 20
# leaked SCALAR(0x9728288) from leaktrace.pl line 34.
#   33:    my $root = LinkedList->new( value => 10 );
#   34:    $root->next(  LinkedList->new( previous => $root, value => 20 ) );
#   35:};
# SV = IV(0x9728284) at 0x9728288
#   REFCNT = 1
#   FLAGS = (IOK,pIOK)
#   IV = 20
1..1
# Looks like you failed 1 test of 1.

実際のコードは以下のとおり。

• https://github.com/gfx/p5-Text-Xslate/blob/master/t/010_internals/200_leaktrace.t
• https://github.com/gfx/Perl-Data-Clone/blob/master/t/11_leaktrace.t

*1:これは厳密に言うとメモリリークではないが、症状としてはメモリリークそのものなので広義でのメモリリークといえる。

*2:なお、--weakを付けて起動すると循環参照の一方を弱参照にするのでメモリリークしなくなる。

*3:実際には、私はXSでのメモリリーク検出にしか使ったことがないので絶対に確かとは言えない。