B::Size2 をデバッグしたときのメモ

B::Size2 で問題が起きるという報告を受けて修正するまでのメモ。
まず再現ですが、これは標準モジュールを使っても簡単に再現できたのでテストに追加してこれを使います。

diff --git a/t/002.terse.t b/t/002.terse.t
index ccf6a99..02de21a 100644
--- a/t/002.terse.t
+++ b/t/002.terse.t
@@ -6,7 +6,7 @@ use Test::More tests => 1;
 use B::Size2;
 use B::Size2::Terse;
 
-foreach my $pkg (qw(main B::Size2 B::Size2::Terse)) {
+foreach my $pkg (qw(main B::Size2 B::Size2::Terse Test::More)) {
 	my($subs, $opcount, $opsize) = B::Size2::Terse::package_size($pkg);
 }
 pass "use of package_size()";

まず gdb -args perl -Mblib t/002.terse.t してrunするとSEGVないしassertion failedで止まります。そこでbtするとこんな感じ。

(gdb) bt
#0  0x00007fff91686d50 in abort ()
#1  0x00007fff91687e2a in __assert_rtn ()
#2  0x00000001002cd022 in XS_B__PVMG_MAGIC ()
#3  0x00000001000de162 in Perl_pp_entersub (my_perl=0x100803200) at pp_hot.c:3046
#4  0x000000010009dc2b in Perl_runops_debug (my_perl=0x100803200) at dump.c:2266
#5  0x0000000100025657 in S_run_body [inlined] () at /Users/fuji.goro/perl5/perlbrew/build/perl-5.14.2/perl.c:2350
#6  0x0000000100025657 in perl_run (my_perl=0x100803200) at perl.c:2268
#7  0x0000000100000e8d in main (argc=2, argv=0x7fff5fbff238, env=0x7fff5fbff250) at perlmain.c:12

しかしこれではよくわかりません。なのでPerlスクリプト側の現在地も見てみます。これはPL_curcopというマクロからみれますが、実体はPerlのビルドオプションやバージョンによって微妙に違ったりするので、perlのソースツリーで ack PL_curcop *.h して当たりをつけます。どうやら my_perl->Icurcop のようですね*1。

(gdb) p *(my_perl->Icurcop)
$1 = {
  op_next = 0x1005e5850, 
  op_sibling = 0x1005e5880, 
  op_ppaddr = 0x1000cc870 <Perl_pp_nextstate>, 
  op_targ = 0, 
  op_type = 181, 
  op_opt = 1, 
  op_latefree = 0, 
  op_latefreed = 0, 
  op_attached = 0, 
  op_spare = 0, 
  op_flags = 1 '\001', 
  op_private = 0 '\0', 
  cop_line = 82, 
  cop_stashpv = 0x1005e5590 "B::Size2", 
  cop_file = 0x1005e58c0 "/***/p5-B-Size2/blib/lib/B/Size2.pm", 
  cop_hints = 1794, 
  cop_seq = 1612, 
  cop_warnings = 0x8, 
  cop_hints_hash = 0x0
}

Size2.pmの82行目ですね。該当箇所はこんな感じです。

sub B::PVMG::size {
    my $sv = shift;
    my $size = B::Sizeof::SV + B::Sizeof::XPVMG;
    my(@chain) = $sv->MAGIC; # ここで落ちている！
    for my $mg (@chain) {
        $size += B::Sizeof::MAGIC + $mg->LENGTH;
    }
    $size;
}

さてスタックトレースを見直すと、クラッシュしていたのは XS_B__PVMG_MAGIC() です。これでクラッシュ箇所を特定できました。精査するためにDevel::Peekを仕込みましょう*2。

diff --git a/lib/B/Size2.pm b/lib/B/Size2.pm
index c0944de..9990869 100644
--- a/lib/B/Size2.pm
+++ b/lib/B/Size2.pm
@@ -79,6 +79,7 @@ sub B::PVLV::size {
 sub B::PVMG::size {
     my $sv = shift;
     my $size = B::Sizeof::SV + B::Sizeof::XPVMG;
+    use Devel::Peek; Dump $sv->object_2svref;
     my(@chain) = $sv->MAGIC;
     for my $mg (@chain) {
         $size += B::Sizeof::MAGIC + $mg->LENGTH;

そしてスクリプトを走らせると以下の様な出力が得られます。どうもこのSVに対してMAGIC()メソッドを呼ぶとクラッシュするようです。FAKEとかOURとかEVALEDという怪しげなフラグがありますね。

SV = IV(0x7fb79383ed88) at 0x7fb79383ed98
  REFCNT = 1
  FLAGS = (TEMP,ROK)
  RV = 0x7fb7938ad7a8
  SV = PVMG(0x7fb79385dea8) at 0x7fb7938ad7a8
    REFCNT = 2
    FLAGS = (POK,FAKE,pPOK,OUR,EVALED)
    IV = 0
    COP_LOW = 0
    COP_HIGH = 0
    PV = 0x7fb7936623e8 "@Data_Stack"\0
    CUR = 11
    LEN = 24
    OURSTASH = 0x7fb793872de8	"Test::More"
Assertion failed: (!SvPAD_OUR(_svmagic)), function XS_B__PVMG_MAGIC, file B.xs, line 1663.

まずassertion失敗の原因を見ます。perl source codeをcloneしてきて `find . -name B.xs` してファイルを探して中を見ます。

void
MAGIC(sv)
	B::PVMG	sv
	MAGIC *	mg = NO_INIT
    PPCODE:
	for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) // ここで落ちてる！
	    XPUSHs(make_mg_object(aTHX_ mg));

SvMAGIC()で落ちてるようなのでこれも見ます。

#line 1122 sv.c
#    define SvMAGIC(sv)							\
	(*({ const SV *const _svmagic = (const SV *)(sv);		\
	    assert(SvTYPE(_svmagic) >= SVt_PVMG);			\
	    if(SvTYPE(_svmagic) == SVt_PVMG)				\
		assert(!SvPAD_OUR(_svmagic));	/* ここで落ちている！*/			\
	    &(((XPVMG*) MUTABLE_PTR(SvANY(_svmagic)))->xmg_u.xmg_magic); \
	  }))

だいたい分かって来ました。どうやら B::PVMG::MAGIC() (実体はCのSvMAGIC()) を OUR flag の立ったSVに対して呼んではいけないようですね。

原因がわかったので回避コードを入れてテストが通ることを確認しましょう。ただしSVフラグたちは必ずしもBモジュールから参照できるとは限りませんし、フラグのチェックマクロやフラグそのものの値もperlのバージョンによって異なります。なので必要なバージョンのperlのsv.hを眺めながらコードを書きます。

diff --git a/lib/B/Size2.pm b/lib/B/Size2.pm
index c0944de..2fc41ff 100644
--- a/lib/B/Size2.pm
+++ b/lib/B/Size2.pm
@@ -24,6 +24,16 @@ BEGIN {
     *B::UNOP::size = \&B::Sizeof::UNOP;
 }
 
+use constant _CHECK_SVPAD_OUR_FOR_MAGIC => $] < 5.016;
+
+use constant _SVpad_NAME => 0x40000000; # sv.h
+use constant _SVpad_OUR  => 0x00040000; # sv.h
+
+sub _SvPAD_OUR { # see SvPAD_OUR()@sv.h
+    my($sv) = @_;
+    return ($sv->FLAGS() & _SVpad_NAME|_SVpad_OUR) == (_SVpad_NAME|_SVpad_OUR);
+}
+
 sub B::SVOP::size {
     B::Sizeof::SVOP + shift->sv->size;
 }
@@ -79,9 +89,12 @@ sub B::PVLV::size {
 sub B::PVMG::size {
     my $sv = shift;
     my $size = B::Sizeof::SV + B::Sizeof::XPVMG;
-    my(@chain) = $sv->MAGIC;
-    for my $mg (@chain) {
-        $size += B::Sizeof::MAGIC + $mg->LENGTH;
+
+    if (_CHECK_SVPAD_OUR_FOR_MAGIC && !_SvPAD_OUR($sv)){
+        my(@chain) = $sv->MAGIC;
+        for my $mg (@chain) {
+            $size += B::Sizeof::MAGIC + $mg->LENGTH;
+        }
     }
     $size;
 }

どうやらこれで良さそうです。報告者のもとで動作するのを確認して v2.02 としてリリースしました。

https://github.com/gfx/p5-B-Size2/commit/9fe867dcaed05bdb46942d246e414f1abd39aae8

*1:このあたりはマジカルな発想の飛躍があるように見えるかもしれませんが、経験による知識です！今回は細かく説明しません。

*2:Devel::Peekの読み方は http://gihyo.jp/dev/serial/01/perl-hackers-hub/001601 に基本的なことを書きました。