sv_reset: Don’t skip THINKFIRST items
authorFather Chrysostomos <sprout@cpan.org>
Sun, 11 Aug 2013 18:52:35 +0000 (11:52 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 11 Aug 2013 19:35:29 +0000 (12:35 -0700)
Commit 9e35f4b3b4 made sv_reset skip SVs other than refs that had
SvTHINKFIRST set.  Back then SvTHINKFIRST was only true for refe-
rences and read-only variables, so this change was technically cor-
rect (except for skipping arrays and hashes, which this commit
does not fix).

But SvTHINKFIRST was expanded later (beginning in commit 6fc926691,
by the author of 9e35f4b3b4), making this code in sv_reset wrong.

In all fairness, it was already wrong before for things marked FAKE,
just differently wrong.

sv.c
t/op/reset.t

diff --git a/sv.c b/sv.c
index 2cb036e..a861716 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -9148,13 +9148,11 @@ Perl_sv_resetpvn(pTHX_ const char *s, STRLEN len, HV * const stash)
                gv = MUTABLE_GV(HeVAL(entry));
                sv = GvSV(gv);
                if (sv) {
-                   if (SvTHINKFIRST(sv)) {
-                       if (!SvREADONLY(sv) && SvROK(sv))
-                           sv_unref(sv);
+                   if (SvREADONLY(sv))
                        /* XXX Is this continue a bug? Why should THINKFIRST
                           exempt us from resetting arrays and hashes?  */
                        continue;
-                   }
+                   SV_CHECK_THINKFIRST_COW_DROP(sv);
                    SvOK_off(sv);
                    if (SvTYPE(sv) >= SVt_PV) {
                        SvCUR_set(sv, 0);
index 5c3b162..25862ef 100644 (file)
@@ -7,7 +7,7 @@ BEGIN {
 }
 use strict;
 
-plan tests => 31;
+plan tests => 32;
 
 package aiieee;
 
@@ -103,6 +103,16 @@ is join("-", $scratch::a//'u', do { no strict; ${"scratch::\0foo"} }//'u'),
    "u-u",
    'reset "\0char"';
 
+$scratch::cow = __PACKAGE__;
+$scratch::qr = ${qr//};
+$scratch::v  = v6;
+$scratch::glob = *is;
+*scratch::ro = \1;
+package scratch { reset 'cqgvr' }
+is join ("-", map $_//'u', $scratch::cow, $scratch::qr, $scratch::v,
+                           $scratch::glob,$scratch::ro), 'u-u-u-u-1',
+   'cow, qr, vstring, glob, ro test';
+
 # 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