GVs of localised arrays and hashes should be refcounted

Otherwise the GV can be freed before the scope-popping code can put
the old entry back in it:

$ perl -le 'local @{"x"}; delete $::{x}'
Bus error
$ perl -le 'local %{"x"}; delete $::{x}'
Bus error

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 7f6b29b..1a732e6 100644 (file)
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -451,6 +451,11 @@ specific scalar return by C<undef()> (C<&PL_sv_undef> internally).  This
 has been corrected.  C<undef()> is now treated like other undefined
 scalars, as in Perl 5.005.
 
+=item *
+
+It used to be possible to free the typeglob of a localised array or hash
+(e.g., C<local @{"x"}; delete $::{x}>), resulting in a crash on scope exit.
+
 =back
 
 =head1 Known Problems

diff --git a/scope.c b/scope.c
index 9a43eb0..b9051d5 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -317,7 +317,7 @@ Perl_save_ary(pTHX_ GV *gv)
 
     if (!AvREAL(oav) && AvREIFY(oav))
        av_reify(oav);
-    save_pushptrptr(gv, oav, SAVEt_AV);
+    save_pushptrptr(SvREFCNT_inc_simple_NN(gv), oav, SAVEt_AV);
 
     GvAV(gv) = NULL;
     av = GvAVn(gv);
@@ -334,7 +334,9 @@ Perl_save_hash(pTHX_ GV *gv)
 
     PERL_ARGS_ASSERT_SAVE_HASH;
 
-    save_pushptrptr(gv, (ohv = GvHVn(gv)), SAVEt_HV);
+    save_pushptrptr(
+       SvREFCNT_inc_simple_NN(gv), (ohv = GvHVn(gv)), SAVEt_HV
+    );
 
     GvHV(gv) = NULL;
     hv = GvHVn(gv);
@@ -786,6 +788,7 @@ Perl_leave_scope(pTHX_ I32 base)
                SvSETMAGIC(MUTABLE_SV(av));
                PL_localizing = 0;
            }
+           SvREFCNT_dec(gv);
            break;
        case SAVEt_HV:                          /* hash reference */
            hv = MUTABLE_HV(SSPOPPTR);
@@ -797,6 +800,7 @@ Perl_leave_scope(pTHX_ I32 base)
                SvSETMAGIC(MUTABLE_SV(hv));
                PL_localizing = 0;
            }
+           SvREFCNT_dec(gv);
            break;
        case SAVEt_INT_SMALL:
            ptr = SSPOPPTR;

diff --git a/t/op/local.t b/t/op/local.t
index 1f36a73..d93306f 100644 (file)
--- a/t/op/local.t
+++ b/t/op/local.t
@@ -5,7 +5,7 @@ BEGIN {
     @INC = qw(. ../lib);
     require './test.pl';
 }
-plan tests => 306;
+plan tests => 307;
 
 my $list_assignment_supported = 1;
 
@@ -792,11 +792,15 @@ like( runperl(stderr => 1,
                       'index(q(a), foo);' .
                       'local *g=${::}{foo};print q(ok);'), "ok", "[perl #52740]");
 
-# Keep this test last, as it can SEGV
+# Keep these tests last, as they can SEGV
 {
     local *@;
     pass("Localised *@");
     eval {1};
     pass("Can eval with *@ localised");
-}
 
+    local @{"nugguton"};
+    local %{"netgonch"};
+    delete $::{$_} for 'nugguton','netgonch';
+}
+pass ('localised arrays and hashes do not crash if glob is deleted');