Skip Menu |

This queue is for tickets about the Scalar-List-Utils CPAN distribution.

Report information
The Basics
Id: 116961
Status: open
Priority: 0/
Queue: Scalar-List-Utils

People
Owner: Nobody in particular
Requestors: ilmari+cpan [...] ilmari.org
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: (no value)



Subject: subname() segfaults on deleted stash
$ perl -MSub::Util=subname -e '{ package Foo; sub bar {} } my $sub = \&Foo::Bar; delete $::{"Foo::"}; subname($sub)' Segmentation fault Full backtrace from Sub::Util 1.45 on debugging perl 5.24.0: Program received signal SIGSEGV, Segmentation fault. 0x00007ffff626c3b5 in XS_Sub__Util_subname (cv=<optimized out>) at ListUtil.xs:1513 1513 ListUtil.xs: No such file or directory. (gdb) bt full #0 0x00007ffff626c3b5 in XS_Sub__Util_subname (cv=<optimized out>) at ListUtil.xs:1513 code = 0x624320 cv = <optimized out> sp = 0x606b58 ax = <optimized out> __PRETTY_FUNCTION__ = "XS_Sub__Util_subname" mark = <optimized out> items = <optimized out> #1 0x00007ffff79cb19d in Perl_pp_entersub () at pp_hot.c:3987 markix = <optimized out> is_scalar = false sp = <optimized out> sv = 0x65c998 gv = 0x0 cv = <optimized out> cx = 0x629d00 old_savestack_ix = <optimized out> __PRETTY_FUNCTION__ = "Perl_pp_entersub" #2 0x00007ffff7991b47 in Perl_runops_debug () at dump.c:2239 No locals. #3 0x00007ffff7904e02 in S_run_body (oldscope=1) at perl.c:2483 No locals. #4 perl_run (my_perl=<optimized out>) at perl.c:2406 oldscope = 1 ret = <optimized out> cur_env = {je_prev = 0x7ffff7ddb0c0 <PL_start_env>, je_buf = {{__jmpbuf = {0, 807392774450212573, 4197802, 140737488344944, 0, 0, -807392773155950883, -807410610812588323}, __mask_was_saved = 0, __saved_mask = {__val = {0, 0, 0, 140737351949767, 140733193388033, 0, 4197802, 140737346407192, 0, 0, 4197802, 140737351975653, 0, 0, 140737351889088, 0}}}}, je_ret = 0, je_mustcatch = false, je_old_delaymagic = 0} __PRETTY_FUNCTION__ = "perl_run" #5 0x0000000000400d9b in main (argc=4, argv=0x7fffffffd778, env=0x7fffffffd7a0) at perlmain.c:116 exitstatus = <optimized out> i = <optimized out>
On 2016-08-15 16:09:57, ilmari wrote: Show quoted text
> $ perl -MSub::Util=subname -e '{ package Foo; sub bar {} } my $sub = > \&Foo::Bar; delete $::{"Foo::"}; subname($sub)' > Segmentation fault
Here's a patch, fixing it to return "__UNKNOWN__" for the package name, instead of segfaulting.
Subject: 0001-Fix-subname-segfault-on-deleted-stash.patch
From 0de2599f01dc94248916105f31b2cf7357487c43 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dagfinn=20Ilmari=20Manns=C3=A5ker?= <ilmari@ilmari.org> Date: Mon, 12 Sep 2016 15:24:05 +0100 Subject: [PATCH] Fix subname() segfault on deleted stash Report the package name as __UNKNOWN__ instead. --- ListUtil.xs | 4 +++- t/subname.t | 16 +++++++++++++++- 2 files changed, 18 insertions(+), 2 deletions(-) diff --git a/ListUtil.xs b/ListUtil.xs index 0a2a6e7..6690418 100644 --- a/ListUtil.xs +++ b/ListUtil.xs @@ -1509,6 +1509,7 @@ subname(code) PREINIT: CV *cv; GV *gv; + HV *stash; PPCODE: if (!SvROK(code) && SvGMAGICAL(code)) mg_get(code); @@ -1519,7 +1520,8 @@ PPCODE: if(!(gv = CvGV(cv))) XSRETURN(0); - mPUSHs(newSVpvf("%s::%s", HvNAME(GvSTASH(gv)), GvNAME(gv))); + stash = GvSTASH(gv); + mPUSHs(newSVpvf("%s::%s", stash ? HvNAME(stash) : "__UNKNOWN__", GvNAME(gv))); XSRETURN(1); BOOT: diff --git a/t/subname.t b/t/subname.t index 1bf8a9f..3c6eb84 100644 --- a/t/subname.t +++ b/t/subname.t @@ -3,7 +3,7 @@ BEGIN { $^P |= 0x210 } -use Test::More tests => 18; +use Test::More tests => 20; use B::Deparse; use Sub::Util qw( subname set_subname ); @@ -78,4 +78,18 @@ 'subname of set_subname'); } +# this used to segfault +{ + my $baz; + { + package Foo; + sub bar {} + $baz = sub {}; + } + my $bar = \&Foo::bar; + delete $::{"Foo::"}; + is(subname($bar), "__UNKNOWN__::bar", "named sub from deleted stash"); + like(subname($baz), qr/^__UNKNOWN__::__ANON__\[.+:\d+\]$/, "anon sub from deleted stash"); +} + # vim: ft=perl -- 2.9.3