Make it possible to have read-only glob copies

(aka Fun with Hash::Util)

This script gives ‘Modification of a read-only value’:

use Hash::Util lock_value;
*foo::; # autovivify
lock_value %::, foo::::;
*foo:: = [];

So far so good.  That’s to be expected.  But this one crashes:

use Hash::Util lock_value;
$a{h} = *foo;
lock_value %a, h;
$a{h} = [];

Under debugging builds, it gives assertion failures.

Anyone who knows how the flags work will see immediately what’s wrong,
but for the sake of those who don’t:

The SVf_FAKE flag is set on a copy of a typeglob, meaning that assign-
ing something other than a glob to it will overwrite the glob, instead
of writing to one of its slots.

The SVf_FAKE flag on a read-only (SVf_READONLY-flagged) string means
that it’s not actually read-only, but a copy-on-write string.

SVf_READONLY on a glob means that you can’t even assign *through* it.
See the first Hash::Util example above.

The crashing occurs when the two flags are combined.
sv_force_normal_flags assumes that anything marked fake AND read-only
is a copy-on-write string, so it proceeds to gut it, even if it’s
actually just corrupting a glob.

So this commit changes that check to take typeglobs into account.

2 files changed, 10 insertions, 2 deletions

diff --git a/sv.c b/sv.c
index f330e5efda..6b3785966b 100644
--- a/sv.c
+++ b/sv.c
@@ -4780,7 +4780,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *const sv, const U32 flags)
     }
 #else
     if (SvREADONLY(sv)) {
-	if (SvFAKE(sv)) {
+	if (SvFAKE(sv) && !isGV_with_GP(sv)) {
 	    const char * const pvx = SvPVX_const(sv);
 	    const STRLEN len = SvCUR(sv);
 	    SvFAKE_off(sv);
diff --git a/t/lib/universal.t b/t/lib/universal.t
index d8c088920b..af4a828562 100644
--- a/t/lib/universal.t
+++ b/t/lib/universal.t
@@ -6,7 +6,7 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require './test.pl';
-    plan( tests => 4 );
+    plan( tests => 5 );
 }
 
 for my $arg ('', 'q[]', qw( 1 undef )) {
@@ -23,3 +23,11 @@ Usage: Internals::hv_clear_placeholders(hv) at (eval 3) line 1.
 Internals::HvREHASH $hashref at (eval 4) line 1.
 ====
 }
+
+# Various conundrums with SvREADONLY
+
+$x = *foo;
+Internals::SvREADONLY $x, 1;
+eval { $x = [] };
+like $@, qr/Modification of a read-only value attempted at/,
+    'read-only glob copies';