我正在尝试编写一些公开文件库的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
函数被调用,所以我还没有完全
到目前为止搞砸了。 (我通过插入debug 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)));
治愈症状:close
时调用$fh
函数
在块结束时超出范围。但我还是不太清楚
了解潜在的问题。
这是为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结束?
答案 0 :(得分:7)
如果在全局销毁时调用close
,则表示您的句柄仍然存在于全局销毁中。你漏了!
在C / XS代码中,您可以使用sv_dump(sv)
将标量转储到stderr。在Perl代码中,您可以使用Devel::Peek的Dump
来获得相同的功能。这将显示参考计数。
回答你的新问题,
你有三个分配,但只有一个释放(来自sv_2mortal的延迟分配)。
gv
:指针总是被丢弃。内存泄漏!
您可以在出错时递减gv
的refcnt,或者在打开成功后使用newRV_inc
将“转让所有权”转移到RV后无条件地减少refcnt。
来自newRV
的SV:指针总是被丢弃。内存泄漏!
为什么不把它归还而不是复制呢?只需将其标记为凡人即可使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);
}
答案 1 :(得分:0)
我只是用一个简单的例子重现了这个问题:
$ 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*
处理默认情况下似乎是漏洞。 : - (
以下typemap
代码段似乎解决了这个问题(谢谢,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;
}
}