This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
GVs of localised arrays and hashes should be refcounted
authorFather Chrysostomos <sprout@cpan.org>
Sat, 27 Aug 2011 06:31:36 +0000 (23:31 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sat, 27 Aug 2011 06:44:38 +0000 (23:44 -0700)
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

pod/perldelta.pod
scope.c
t/op/local.t

index 7f6b29b..1a732e6 100644 (file)
@@ -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;
index 1f36a73..d93306f 100644 (file)
@@ -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');