This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Stop reset from skipping @ % if $ is read-only
authorFather Chrysostomos <sprout@cpan.org>
Sun, 11 Aug 2013 19:29:31 +0000 (12:29 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 11 Aug 2013 19:35:34 +0000 (12:35 -0700)
reset has been wrongly skipping arrays and hashes in the same glob as
read-only scalars since commit 9e35f4b3b4.

sv.c
t/op/reset.t

diff --git a/sv.c b/sv.c
index a861716..36a9908 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -9147,11 +9147,7 @@ Perl_sv_resetpvn(pTHX_ const char *s, STRLEN len, HV * const stash)
                    continue;
                gv = MUTABLE_GV(HeVAL(entry));
                sv = GvSV(gv);
                    continue;
                gv = MUTABLE_GV(HeVAL(entry));
                sv = GvSV(gv);
-               if (sv) {
-                   if (SvREADONLY(sv))
-                       /* XXX Is this continue a bug? Why should THINKFIRST
-                          exempt us from resetting arrays and hashes?  */
-                       continue;
+               if (sv && !SvREADONLY(sv)) {
                    SV_CHECK_THINKFIRST_COW_DROP(sv);
                    SvOK_off(sv);
                    if (SvTYPE(sv) >= SVt_PV) {
                    SV_CHECK_THINKFIRST_COW_DROP(sv);
                    SvOK_off(sv);
                    if (SvTYPE(sv) >= SVt_PV) {
index 93121af..f6c06d3 100644 (file)
@@ -7,7 +7,7 @@ BEGIN {
 }
 use strict;
 
 }
 use strict;
 
-plan tests => 34;
+plan tests => 37;
 
 package aiieee;
 
 
 package aiieee;
 
@@ -119,6 +119,14 @@ package scratch { reset 'a' }
 is @scratch::an_array, 0, 'resetting an array';
 is %scratch::a_hash,   0, 'resetting a hash';
 
 is @scratch::an_array, 0, 'resetting an array';
 is %scratch::a_hash,   0, 'resetting a hash';
 
+@scratch::an_array = 1..3;
+%scratch::an_array = 1..4;
+*scratch::an_array = \1;
+package scratch { reset 'a' }
+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';
+
 # 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
 # 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