diff options
| -rw-r--r-- | pp.c | 1 | ||||
| -rw-r--r-- | sv.c | 7 | ||||
| -rw-r--r-- | t/op/gv.t | 59 |
3 files changed, 65 insertions, 2 deletions
@@ -1024,6 +1024,7 @@ PP(pp_undef) else stash = NULL; } + SvREFCNT_inc_simple_void_NN(sv_2mortal(sv)); gp_free(MUTABLE_GV(sv)); Newxz(gp, 1, GP); GvGP_set(sv, gp_ref(gp)); @@ -3773,6 +3773,8 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype) ); } } + + SvREFCNT_inc_simple_void_NN(sv_2mortal(dstr)); } gp_free(MUTABLE_GV(dstr)); @@ -4312,8 +4314,10 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags) reset_isa = TRUE; } - if (GvGP(dstr)) + if (GvGP(dstr)) { + SvREFCNT_inc_simple_void_NN(sv_2mortal(dstr)); gp_free(MUTABLE_GV(dstr)); + } GvGP_set(dstr, gp_ref(GvGP(gv))); if (reset_isa) { @@ -9940,6 +9944,7 @@ S_sv_unglob(pTHX_ SV *const sv, U32 flags) if (!(flags & SV_COW_DROP_PV)) gv_efullname3(temp, MUTABLE_GV(sv), "*"); + SvREFCNT_inc_simple_void_NN(sv_2mortal(sv)); if (GvGP(sv)) { if(GvCVu((const GV *)sv) && (stash = GvSTASH(MUTABLE_GV(sv))) && HvNAME_get(stash)) @@ -12,7 +12,7 @@ BEGIN { use warnings; -plan( tests => 259 ); +plan( tests => 271 ); # type coercion on assignment $foo = 'foo'; @@ -962,6 +962,63 @@ sub Undefiner::DESTROY { 'undeffing a gv in DESTROY triggered by undeffing the same gv' } +# [perl #121242] +# More gp_free madness. gp_free could call a destructor that frees the gv +# whose gp is being freed. +sub Fred::AUTOLOAD { $Fred::AUTOLOAD } +undef *{"Fred::AUTOLOAD"}; +pass 'no crash from gp_free triggering gv_try_downgrade'; +sub _121242::DESTROY { delete $_121242::{$_[0][0]} }; +${"_121242::foo"} = bless ["foo"], _121242::; +undef *{"_121242::foo"}; +pass 'no crash from pp_undef/gp_free freeing the gv'; +${"_121242::bar"} = bless ["bar"], _121242::; +*{"_121242::bar"} = "bar"; +pass 'no crash from sv_setsv/gp_free freeing the gv'; +${"_121242::baz"} = bless ["baz"], _121242::; +*{"_121242::baz"} = *foo; +pass 'no crash from glob_assign_glob/gp_free freeing the gv'; +{ + my $foo; + undef *_121242::DESTROY; + *_121242::DESTROY = sub { undef $foo }; + my $set_up_foo = sub { + # Make $$foo into a fake glob whose array slot holds a blessed + # array that undefines $foo, freeing the fake glob. + $foo = undef; + $$foo = do {local *bar}; + *$$foo = bless [], _121242::; + }; + &$set_up_foo; + $$foo = 3; + pass 'no crash from sv_setsv/sv_unglob/gp_free freeing the gv'; + &$set_up_foo; + utf8::encode $$foo; + pass 'no crash from sv_utf8_encode/sv_unglob/gp_free freeing the gv'; + &$set_up_foo; + open BAR, "TEST"; + $$foo .= <BAR>; + pass 'no crash from do_readline/sv_unglob/gp_free freeing the gv'; + close BAR; + &$set_up_foo; + $$foo .= 3; + pass 'no crash from pp_concat/sv_unglob/gp_free freeing the gv'; + &$set_up_foo; + no warnings; + $$foo++; + pass 'no crash from sv_inc/sv_unglob/gp_free freeing the gv'; + &$set_up_foo; + $$foo--; + pass 'no crash from sv_dec/sv_unglob/gp_free freeing the gv'; + &$set_up_foo; + undef $$foo; + pass 'no crash from pp_undef/sv_unglob/gp_free freeing the gv'; + $foo = undef; + $$foo = 3; + $$foo =~ s/3/$$foo = do {local *bar}; *$$foo = bless [],_121242::; 4/e; + pass 'no crash from pp_substcont/sv_unglob/gp_free freeing the gv'; +} + # *{undef} eval { *{my $undef} = 3 }; like $@, qr/^Can't use an undefined value as a symbol reference at /, |