Perl の warn は何をしているの？

最近 Go ばっかだったので、久しぶりに Perl を書いてると色々疑問が出てきました。その中の一つが「$SIG{__WARN__} に代入されたサブルーチンが実行されるタイミング」でした。

__WARN__ とあるので、 warn を実行した時がトリガーになって実行されるものだろうというのは予想できていましたが、僕が warn の処理内容を内部で caller のようなものを実行し、package 名、warn を実行した行番号を取得して stderr へ出力しているものだと思っていました。そのため「stderr を通じて出力された時がトリガーとなって $SIG{__WARN__} が呼び出される」と考えたのですが、Okinawa.pm の Slack で

というようなアドバイスをもらったので以下のようなコードを書いて試してみました。

use strict;
use warnings;
use Carp;
BEGIN {
    $SIG{__WARN__} = sub { print "CALLED!!\n" };
}

warn "First\n";
carp "Second\n";
print STDERR "Third\n";

結果は

CALLED!!
CALLED!!
Third

というような結果を得ることができました。carp も内部では warn を呼び出しているようなので、結果から warn を実行したタイミングがトリガーになるということが分かりました！

…が今度は warn って実際に何やってるのだろうという疑問が出てきたので、コードを大まかに追ってみることにしました。
これが多分 warn のソースコード。この関数の中で vwarn という関数を呼んでいますが、実際は Perl_vwarn のマクロ みたいですね！
ということは warn の本体である Perl_vwarn を読んでみると stderr へ書き出す前に invoke_exception_hook という S_invoke_exception_hook のマクロが呼び出されていることが分かりますね！
S_invoke_exception_hook のコードです。

STATIC bool
S_invoke_exception_hook(pTHX_ SV *ex, bool warn)
{
    HV *stash;
    GV *gv;
    CV *cv;
    SV **const hook = warn ? &PL_warnhook : &PL_diehook;
    /* sv_2cv might call Perl_croak() or Perl_warner() */
    SV * const oldhook = *hook;

    if (!oldhook)
    return FALSE;

    ENTER;
    SAVESPTR(*hook);
    *hook = NULL;
    cv = sv_2cv(oldhook, &stash, &gv, 0);
    LEAVE;
    if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) {
    dSP;
    SV *exarg;

    ENTER;
    save_re_context();
    if (warn) {
        SAVESPTR(*hook);
        *hook = NULL;
    }
    exarg = newSVsv(ex);
    SvREADONLY_on(exarg);
    SAVEFREESV(exarg);

    PUSHSTACKi(warn ? PERLSI_WARNHOOK : PERLSI_DIEHOOK);
    PUSHMARK(SP);
    XPUSHs(exarg);
    PUTBACK;
    call_sv(MUTABLE_SV(cv), G_DISCARD);
    POPSTACK;
    LEAVE;
    return TRUE;
    }
    return FALSE;
}

分からない部分多すぎて泣けてくる…

きっと SV **const hook = warn ? &PL_warnhook : &PL_diehook; の部分で hook 変数に $SIG{__WARN__} へ代入されたサブルーチンを渡していて、SV * const oldhook = *hook; して cv = sv_2cv(oldhook, &stash, &gv, 0); を行って最終的に cv 変数の中にサブルーチンが代入されるのだろうと。 call_sv(MUTABLE_SV(cv), G_DISCARD); でそのサブルーチンが実行されているんだろうなと考えました。間違っていたら教えてください。

ちなみに $SIG{__WARN__} 部分のコードは Perl_magic_setsig だと思います。

結論

• warn は stderr へ出力するだけの関数ではない。
• warn は $SIG{__WARN__} に代入されたサブルーチンを実行して stderr へ出力する。

…多分!!!!