Re: Re: perl 5.16.0 でメモリリーク?

修正してpull-requestを送りました。

githubのpull-req/issuesではなくperlbugでレポートしてほしいとのこと。今回は tokuhiromの報告があったのでそれで。パッチ自体は問題ないようなので、Perl 5.16.1 では修正されるでしょう。

以下蛇足。
せっかくなので、何を考えながらデバッグしたかを記録しておく。

今回のバグはSVのリークではなくmalloc()したメモリの開放忘れだったので、Test::LeakTraceが使えず苦労した。最終的には、アタリをつけてgdbで追うという地味な作業となった。

問題となるコードは以下のようなものである。

my $o = bless {};
while (1) {
    for my $r([], $o) {
        ref $r;
    }
}

不思議な事に、少し条件を変えるだけでリークが発生しなくなる。特にforと[] (任意のリファレンスでいいが、オブジェクトであってはいけない)が必須であることが不可解である。
しかしともかく問題は ref() にありそうだ。そこで、ref() の実装である Perl_sv_reftype() からソースを読んでゆく。

Perl_sv_reftype()を見ると、単純なリファレンスのときは文字列リテラルを直接返しているので除外。怪しいの引数がオブジェクトであるケースだ。

sv.c line 9130

const char*
Perl_sv_reftype(pTHX_ const SV *const sv, const int ob)
{
    PERL_ARGS_ASSERT_SV_REFTYPE;
    if (ob && SvOBJECT(sv)) {
        return SvPV_nolen_const(sv_ref(NULL, sv, ob));
    }
    else { /* ... */ }

となるとPerl_sv_ref()が怪しい。これも同じく sv.c にある。

sv.c line 9180

SV *
Perl_sv_ref(pTHX_ register SV *dst, const SV *const sv, const int ob)
{
    PERL_ARGS_ASSERT_SV_REF;

    if (!dst)
        dst = sv_newmortal();

    if (ob && SvOBJECT(sv)) {
	HvNAME_get(SvSTASH(sv))
                    ? sv_sethek(dst, HvNAME_HEK(SvSTASH(sv)))
                    : sv_setpvn(dst, "__ANON__", 8);
    }
    else { /* ... */ }

今回追っているのは sv がオブジェクトであるケースなので、これは Perl_sv_sethek() に分岐する。このsv_sethek() は 2011年10月のコミットである 70b71ec84 で導入された関数であり、かなり新しい。新しいAPIにバグはつきものである。

この sv_sethek() は中でいくつか分岐しているが、パッとみて今回どの分岐を通るのかは分かりにくかった。そこで、gdbで追った。

すると途中の分岐には入らず、最後のブロックが実行されていることがわかる。

sv.c line 4553

        {
	    SV_CHECK_THINKFIRST_COW_DROP(sv);
	    SvUPGRADE(sv, SVt_PV);
	    SvPV_set(sv,(char *)HEK_KEY(share_hek_hek(hek)));
	    SvCUR_set(sv, HEK_LEN(hek));
	    SvLEN_set(sv, 0);
	    SvREADONLY_on(sv);
	    SvFAKE_on(sv);
	    SvPOK_on(sv);
	    if (HEK_UTF8(hek))
		SvUTF8_on(sv);
	    else SvUTF8_off(sv);
            return;
	}

ここでローカル変数 sv を gdb上で p Perl_sv_dump(sv) で出力しつつなんどか繰り返すと、svのヘッダやボディのアドレスは変化せず *1、PVのアドレスだけが毎回変わっていることがわかった。

つまり、 SvPV_set(sv,(char *)HEK_KEY(share_hek_hek(hek))) が怪しい!これは文字列用バッファたるPVに無条件で値をセットしているが、事前に割り当てたバッファがあるなら開放すべきなのだ。無条件でセットしていいのは、作成したばかりのsvであるときなどの限られた状況だけだ。

かくして以下のパッチでメモリリークを修正することができた。

diff --git a/sv.c b/sv.c
--- a/sv.c
+++ b/sv.c
@@ -4553,6 +4553,7 @@ Perl_sv_sethek(pTHX_ register SV *const sv, const HEK *const hek)
         {
 	    SV_CHECK_THINKFIRST_COW_DROP(sv);
 	    SvUPGRADE(sv, SVt_PV);
+	    Safefree(SvPVX(sv));
 	    SvPV_set(sv,(char *)HEK_KEY(share_hek_hek(hek)));
 	    SvCUR_set(sv, HEK_LEN(hek));
 	    SvLEN_set(sv, 0);

追記:
なぜこの条件だと最近リークするようになったのか。それは、ref($object) のためのPVを毎回割り当てるのではなく、shared SV (COW) を活用する最適化を入れた結果のエンバグと思われる。sv_sethek()の前の分岐もそのためで、特定条件下では新しくメモリを割り当てることなく処理を終えられるようになったのだ。

ref($object)の場合はそれでいいし、このref()の引数が単純なリファレンスの場合はいままで通りの処理で問題にはならない。しかし、同じ ref() のopcodeに対して単純なリファレンスとオブジェクトリファレンスを交互に渡したときの処理がうまく行っていなかった。TARGはopcode毎に静的に割り当てられるからである。

つまり、Perl 5.16.0 からは ref() の引数がオブジェクトであるとき、shared SV であるはずだ。

以下のコードでこのことが確かめられる。

$ perlbrew exec perl -MDevel::Peek -e 'Dump ref []; Dump ref bless {}' 
perl-5.14.2
==========
SV = PV(0x7fdffb001c80) at 0x7fdffb02b6a8
  REFCNT = 1
  FLAGS = (PADTMP,POK,pPOK)
  PV = 0x109f02e60 "ARRAY"\0
  CUR = 5
  LEN = 16
SV = PV(0x7fdffb001da0) at 0x7fdffb02b690
  REFCNT = 1
  FLAGS = (PADTMP,POK,pPOK)
  PV = 0x109f0c860 "main"\0
  CUR = 4
  LEN = 16

perl-5.16.0
==========
SV = PV(0x7fcefb801e80) at 0x7fcefb82ac28
  REFCNT = 1
  FLAGS = (PADTMP,POK,pPOK)
  PV = 0x101f02e40 "ARRAY"\0
  CUR = 5
  LEN = 16
SV = PV(0x7fcefb801fa0) at 0x7fcefb82ac10
  REFCNT = 1
  FLAGS = (PADTMP,POK,FAKE,READONLY,pPOK)
  PV = 0x101f02060 "main"
  CUR = 4
  LEN = 0

FAKEフラグと LEN = 0 というのが shared SV を意味している。

*1:※詳しく追うと、TARG - 戻り値用に静的に割り当てられたSV - であることがわかる。静的に割り当てられたSVなので、svそのものは変化しない