This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove SvIsCOW checks from mg.c:mg_localize
authorFather Chrysostomos <sprout@cpan.org>
Wed, 7 Aug 2013 15:12:27 +0000 (08:12 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 11 Aug 2013 14:41:26 +0000 (07:41 -0700)
It no longer needs to worry about SvIsCOW.  This logic is left over
from when READONLY+FAKE was used for COWs.

Since it is possible for COWs to be read-only now, this logic is actu-
ally faulty, as it doesn’t temporarily stop read-only COWs from being
read-only, as it does for other read-only values.

This actually causes discrepancies with scalar-tied locked hash keys,
which differ in readonliness when localised depending on whether the previous value used copy-on-write.

Whether such scalars should be read-only after localisation is open
to debate, but it should not differ based on the means of storing the
previous value.

mg.c
t/op/tie.t

diff --git a/mg.c b/mg.c
index d22f620..0ce58ab 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -526,7 +526,7 @@ Perl_mg_localize(pTHX_ SV *sv, SV *nsv, bool setmagic)
                            mg->mg_ptr, mg->mg_len);
 
        /* container types should remain read-only across localization */
-       if (!SvIsCOW(sv)) SvFLAGS(nsv) |= SvREADONLY(sv);
+       SvFLAGS(nsv) |= SvREADONLY(sv);
     }
 
     if (SvTYPE(nsv) >= SVt_PVMG && SvMAGIC(nsv)) {
index 5710058..7aff015 100644 (file)
@@ -1382,10 +1382,18 @@ ok
 # Scalar-tied locked hash keys and copy-on-write
 use Tie::Scalar;
 tie $h{foo}, Tie::StdScalar;
-$h{foo} = __PACKAGE__;
+tie $h{bar}, Tie::StdScalar;
+$h{foo} = __PACKAGE__; # COW
+$h{bar} = 1;       # not COW
 # Moral equivalent of Hash::Util::lock_whatever, but miniperl-compatible
 Internals::SvREADONLY($h{foo},1);
-print $h{foo}, "\n";
-
+Internals::SvREADONLY($h{bar},1);
+print $h{foo}, "\n"; # should not croak
+# Whether the value is COW should make no difference here (whether the
+# behaviour is ultimately correct is another matter):
+local $h{foo};
+local $h{bar};
+print "ok\n" if (eval{ $h{foo} = 1 }||$@) eq (eval{ $h{bar} = 1 }||$@);
 EXPECT
 main
+ok