This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Stop reset from clearing aliases to globs
authorFather Chrysostomos <sprout@cpan.org>
Tue, 13 Aug 2013 12:55:12 +0000 (05:55 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Tue, 13 Aug 2013 12:56:49 +0000 (05:56 -0700)
If $z has been aliased to *foo, then reset("z") would turn off the
SvOK flags on *foo, putting it in an inconsistent state.  This could
cause crashes.

sv.c
t/op/reset.t

diff --git a/sv.c b/sv.c
index de0831c..044dc9d 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -9181,7 +9181,7 @@ Perl_sv_resetpvn(pTHX_ const char *s, STRLEN len, HV * const stash)
                sv = GvSV(gv);
                if (sv && !SvREADONLY(sv)) {
                    SV_CHECK_THINKFIRST_COW_DROP(sv);
-                   SvOK_off(sv);
+                   if (!isGV(sv)) SvOK_off(sv);
                }
                if (GvAV(gv)) {
                    av_clear(GvAV(gv));
index f6c06d3..e592430 100644 (file)
@@ -7,7 +7,7 @@ BEGIN {
 }
 use strict;
 
-plan tests => 37;
+plan tests => 39;
 
 package aiieee;
 
@@ -127,6 +127,19 @@ is @scratch::an_array, 0, 'resetting array in the same gv as a ro scalar';
 is @scratch::an_array, 0, 'resetting a hash in the same gv as a ro scalar';
 is $scratch::an_array, 1, 'reset skips ro scalars in the same gv as av/hv';
 
+for our $z (*_) {
+    {
+        local *_;
+        reset "z";
+        $z = 3;
+        () = *_{SCALAR};
+       no warnings;
+        () = "$_";   # used to crash
+    }
+    is ref\$z, "GLOB", 'reset leaves real-globs-as-scalars as GLOBs';
+    is $z, "*main::_", 'And the glob still has the right value';
+}
+
 # This used to crash under threaded builds, because pmops were remembering
 # their stashes by name, rather than by pointer.
 fresh_perl_is( # it crashes more reliably with a smaller script