为什么这个返回 PerlIO* 的 XS 代码会泄漏？

Question

我正在尝试编写一些 XS 代码，将库中的片段公开给 Perl 代码作为可以写入的流接口。这 get_stream 下面的函数应该是一个构造函数 准备并返回一个 PerlIO 对象。我想我只需要 Write 和 Close 方法，所以我将所有其他函数槽留空。

typedef struct {
    struct _PerlIO base;
    mylib_context* ctx;
} PerlIOmylib;

/* [...] */

PERLIO_FUNCS_DECL(PerlIO_mylib_funcs) = {
.fsize = sizeof(PerlIO_funcs),
.name  = "mylib",
.size  = sizeof(PerlIOmylib,
.Write = mylib_write,
.Close = mylib_close,
};

/* XS below */

PerlIO*
get_stream (SV* context_obj)
CODE:
mylib_context* ctx = (mylib_context*) SvIV (SvRV (context_obj));
PerlIO* f = PerlIO_allocate (aTHX);
f = PerlIO_push (aTHX, f, PERLIO_FUNCS_CAST(&PerlIO_mylib_funcs), "a", NULL);
PerlIOSelf(f, PerlIOmylib)->ctx = ctx;
PerlIOBase(f)->flags |= PERLIO_F_OPEN;
RETVAL = f;
OUTPUT:
RETVAL

当我像这样使用提供的界面时......

{
    my $fh = MyLib::get_stream($lib_ctx);
    print $fh "x" x 300;
}

...mylib_write 函数被调用，所以我还没有完全 到目前为止搞砸了。 （我通过插入调试 printf 验证了这一点 声明。）但是，我希望 PerlIO 对象在 $fh 超出范围，就像正常工作一样 由open 创建的文件句柄。但目前，mylib_close 函数仅在解释器关闭期间调用。

直接调用close 可以正常工作，将$fh 设置为undef 可以 不是。

更新：按照 ikegami 的建议，我使用了 Devel::Peek::Dump 和 sv_dump 并发现返回的句柄get_stream 函数是“RV” 它指向SV = PVGV(...)。 glob (PVGV) 有它的 参考计数器设置为 3，这似乎不正确。

我加了

CLEANUP:
SvREFCNT_dec (SvRV (ST(0)));
SvREFCNT_dec (SvRV (ST(0)));

治标不治本：$fh 时调用close 函数 在块的末尾超出范围。但我还是不太懂 了解根本问题。

这是为 OUTPUT 部分生成的 C 代码：

ST(0) = sv_newmortal();
{
    GV *gv = newGVgen("MyLib");
    if (do_open(gv, "+<&", 3, FALSE, 0, 0, RETVAL) )
        sv_setsv(ST(0), sv_bless(newRV((SV*)gv), gv_stashpv("MyLib",1)));
    else
        ST(0) = &PL_sv_undef;
}
XSRETURN(1);

GV 的引用计数如何以 3 结束？

Answer 1

如果在全局销毁时调用close，则意味着您的句柄在全局销毁时仍然存在。你在泄密！

在 C/XS 代码中，您可以使用 sv_dump(sv) 将标量转储到 stderr。在 Perl 代码中，您可以使用Devel::Peek 的Dump 来获得相同的功能。这将显示引用计数。

---

回答您的新问题，

你有三个分配，但只有一个释放（从 sv_2mortal 延迟的一个）。

• gv: 指针总是被丢弃。内存泄漏！

  您可以在出错时减少gv 的引用，或者在打开成功时使用newRV_inc 将所有权“转移”给 RV 后无条件减少引用。

• 来自newRV 的SV：指针总是被丢弃。内存泄漏！

  为什么不直接返回而不是复制它呢？只需将其标记为 mortal 以使 Perl 在调用者获取它后减少其 refcnt。

固定：

{
    GV *gv = newGVgen("MyLib");
    if (!do_open(gv, "+<&", 3, FALSE, 0, 0, RETVAL) ) {
        SvREFCNT_dec(gv);
        XSRETURN_UNDEF;
    }

    ST(0) = sv_2mortal(sv_bless(newRV_noinc((SV*)gv), gv_stashpv("MyLib",1))));
    XSRETURN(1);
}

Answer 2

我只是用一个简单的例子重现了这个问题：

$ h2xs -n foo
Defaulting to backwards compatibility with perl 5.14.2
If you intend this module to be compatible with earlier perl versions, please
specify a minimum perl version with the -b option.

Writing foo/ppport.h
Writing foo/lib/foo.pm
Writing foo/foo.xs
Writing foo/fallback/const-c.inc
Writing foo/fallback/const-xs.inc
Writing foo/Makefile.PL
Writing foo/README
Writing foo/t/foo.t
Writing foo/Changes
Writing foo/MANIFEST

致foo/foo.xs，我补充说：

PerlIO*
get_stream(char* name);
CODE:
RETVAL = PerlIO_open (name, "w");
OUTPUT:
RETVAL

以及以下简单的测试程序：

#!/usr/bin/perl
use foo;
use Devel::Peek;
{
    my $fh = foo::get_stream ("testfile");
    Devel::Peek::Dump $fh;
    print $fh "hello\n";
}
print "bye\n";

果然生成的glob的引用计数设置为3， strace 表明关闭文件描述符是最后 Perl 解释器所做的事情。

所以，PerlIO* 默认处理似乎是泄漏的。 :-(

下面的typemapsn-p 似乎可以解决这个问题（谢谢，ikegami！）：

TYPEMAP
PerlIO *    T_PIO
OUTPUT
T_PIO
    {
        GV *gv = newGVgen("$Package");
        if (do_open(gv, "+<&", 3, FALSE, 0, 0, $var) ) {
            $arg = sv_2mortal(sv_bless(newRV_noinc((SV*)gv), gv_stashpv("$Package",1)));
        } else {
            SvREFCNT_dec(gv);
            $arg = &PL_sv_undef;
        }
    }