p5pRT
commented
25 years ago From roconnor@world.std.com
The following code gets "Segmentation fault (core dumped)":
#! /usr/bin/perl -w
use ExtUtils::testlib;
use strict;
use Mytest;
my $w = MainWindow->new;
my $b = $w->Button();
$b->configure (-command => sub {my $t; $b->destroy; });
$b->invoke;
"Mytest" can either be Tk or the following xs code\, which is intended to be a distillation of the key bug-related parts of what Tk is doing:
#ifdef __cplusplus
extern "C" {
#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#ifdef __cplusplus
}
#endif
static SV * keepSub = (SV*)NULL ;
MODULE = Mytest PACKAGE = Mytest
SV *
new (cv)
SV * cv
CODE:
ST(0) = sv_bless (newRV_noinc (newSVpv (""\, 0))\,
gv_stashpv("Mytest"\, 0));
void
configure(cv\,opt\,name)
SV * cv
SV * opt
SV * name
CODE:
keepSub = newSVsv(name) ;
void
invoke(cv)
SV * cv
CODE:
PUSHMARK(sp) ;
perl_call_sv(SvRV(keepSub)\, G_DISCARD|G_NOARGS) ;
void
destroy(cv)
SV * cv
CODE:
SvREFCNT_dec(keepSub) ;
The same thing happens with 5.004_04\, 5.005_03\, and perl.5005_61.
I spent some time tracking this down\, and I believe that the problem is as follows:
When the callback executes the "my $t;"\, it does a SAVECLEARSV\, which puts an index into curpad on the savestack. Then at the end of the callback\, pp_leavesub does a POPSUB2 which frees the cv including curpad\, and then pp_leavesub does a LEAVE which tries to reference curpad.
The obvious solution would seem to be not to decrement the refcnt on the cv until after LEAVE\, and I've included a patch below to do that.
I considered other possibilities.
Perhaps a sub should not be destroying the only reference to itself. But it seems useful to do so\, there seems to be no reason it should not work\, and since pp_entersub increments the refcnt\, it seems to allow for the possibilty as long as we don't decrement it too soon.
Perhaps we should not be putting references to curpad on the savestack. But the cv was there when it did the SAVECLEARSV\, and it seems reasonable to keep it there until after the LEAVE.
Perhaps SAVECLEARSV should increment a refcnt. But the one incremented by pp_entersub seems like it should cover it.
The PUSHBLOCK/PUSHSUB was done after the ENTER in pp_entersub\, so to keep the nesting consistent\, it would seem that one would want to do the POPSUB before the LEAVE. But decrementing the refcnt doesn't really seem to be part of the POPSUB. pp_entersub increments it after the PUSHSUB\, but it can afford to do so because it knows that someone else has a reference to the sub\, and won't take it away before the end of pp_entersub. Conceptually\, it would be incrementing the refcnt first thing\, if it were convenient. So waiting until after the LEAVE to decrement it is consistent with the nesting.
Guillaume Curtil \gui@​curtil\.rez\-gif\.supelec\.fr reported what I believe is the same bug in comp.lang.perl.tk on 1998/10/06. ("my" and "destroy" in a Tk callback causing segfaults)
Alan Lehotsky \lehotsky@​phosgene\.lex\.rational\.com on 1999/07/06 in perl.porters-gw reported that "Perl seems to deallocate the array addressed via 'curpad' too soon"\, but didn't give a test case.
In my patch\, I didn't just move POPSUB2 after LEAVE\, because it seemed to belong before LEAVE\, and I didn't want to change anything that wasn't necessary to fix the problem. Instead\, I separated just the decrement of the refcnt from POPSUB2\, and called it POPSUB2B\, and put that after LEAVE. I renamed the remainder of POPSUB2 to POPSUB2A\, so anyone who was using POPSUB2 from the header file would have it break\, instead of just silently stop working. I put POPSUB2B after leave in pp_return and pp_last as well\, because they seemed to have the same problem. I didn't change the POPSUB in dounwind\, because it doesn't seem to be followed by a LEAVE that depends on a curpad that might have been freed.
The patch should be fairly safe\, because in the normal case (when the cv is not being freed) it has no effect other than to decrement the refcnt after the LEAVE instead of before.
The patch is a unified diff against 4.004_04 with only one line of context\, so it will apply against 5.005_03\, and 5.005_61 as well.
begin 644 patch.gz M'XL("'BVYS\<``W!A=&-H`\,U478^:0!1]AE]Q-VTVL@@+*)_&Q(^ZZ4/;-=5N M^]#$(([5K`L$1G>;QO_>.X/`N+:[ID_E82#\<KW//.:!I&D1)JJ]T0[K)UO`Q M_`G@@V4$5BNP33!]WY5552V2I$E(84)2\,#TPS\"P@​C9/\\5>#S3;;+9`Q;\,- MO9X\,$L#X=CSY\,C`;T9/2D8KKNZQ5`:NA=&`OJ_6+?D-(%-X/BDPHYCA\CHLG MFR-K;Q9DN8Y)W;5N\2S4%V(@K9>`T/+M7%^%>9C]R!7X54;9(\,=N.J`Z3M\,K M%MI+PA)U\;2KZ@​\[K\`;\#H16\.XS\<:3]\+>5THGI/-8D%2NE*40Y$TV7T>W0P_ M36\<+$M4%G:HKX^EXYA%1`*\/Z\CJ"2\,#D:VC`7!Y"1\<G315QY%\P\,TW05VDZ MB^A&C]!:TRWAOD%KH6]L.V@YM;7*O"K+\,EE6RPULMW:7V?;;3'=^+QQ6$ITF M*8ZV4`7DJ;:6='T%&=F0\,"\<PO(\,P7D!O!KJNP]4U+B!:#C\,G-(SN81=NMB2' M\,".0ATL25`VPDE=)++\<QWU*($XIMF_!AU+\;P0-^.#$A"UA3Y3""X]N7X/VF MA>!MPT!/E>!Y*5?E#ZM4"`\<'A''R*.[#X/`)4%Q%RXS0;18#]ID5CUA\<0+!= MF_-G>X;`7\2[?:\,SG!3\7_1)\XR$]R5ZSRP(]-S7"+2@VRU7.B7R)2:/*(S) M$TW23FGE54*YE;\BR-N(`N`OT\,!?9&`91U;F>\<^M[`6V)UC9\<5M\<"G:WJV5D MC9V"`&?P>BJ\,T*-_9I-_$$\<]N&>;I0_XGXG)8_K`?\<#B#!'J`&]-(!3"#2LX 9[.UR$1W7%_8^%O$\,K5YP^F_$*)!FT`8````` ` end
Migrated from rt.perl.org#1521 (status was 'resolved')
Searchable as RT1521$