Stop regexp assignment from clobbering magic

$ perl5.10.0 -le '$1 = ${qr||}; print "ok"'
Modification of a read-only value attempted at -e line 1.
$ perl5.12.0 -le '$1 = ${qr||}; print "ok"'
ok

Wonderful!

It can also cause blessings to be lost, or so I thought:

sub curse {
  for my $obj ( ${$_[0]} ) {
    my $save = $obj;
    $obj = ${qr||};
    $obj = $save;
  }
}
$y = bless \$x;
print $y, "\n"; # main=SCALAR(0x825b70)
curse $y;
print $y, "\n"; # Bus error

The OBJECT flag gets left on, but SvSTASH is null.

Commit b9ad13acb set SvSTASH to null after copying the regexp struct.
Commit 703c388dc did the same with SvMAGIC.  In both cases, this was
to avoid bugs involving magic and blessings being copied by = which
should not happen.  But both changes caused other bugs.

Three months later, 6e1287864cd changed the order of the struct, such
that SvMAGIC and SvSTASH are no longer copied from the parent regexp,
rendering the aforementioned changes no longer necessary.

diff --git a/regcomp.c b/regcomp.c
index 6a106f8..f676645 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -14193,8 +14193,6 @@ Perl_reg_temp_copy (pTHX_ REGEXP *ret_x, REGEXP *rx)
     memcpy(&(ret->xpv_cur), &(r->xpv_cur),
           sizeof(regexp) - STRUCT_OFFSET(regexp, xpv_cur));
     SvLEN_set(ret_x, 0);
-    SvSTASH_set(ret_x, NULL);
-    SvMAGIC_set(ret_x, NULL);
     if (r->offs) {
         const I32 npar = r->nparens+1;
         Newx(ret->offs, npar, regexp_paren_pair);

diff --git a/t/op/qr.t b/t/op/qr.t
index 9d78abf..fb82d73 100644 (file)
--- a/t/op/qr.t
+++ b/t/op/qr.t
@@ -7,7 +7,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan(tests => 21);
+plan(tests => 24);
 
 sub r {
     return qr/Good/;
@@ -72,3 +72,13 @@ is $_, "bazbar", '[perl #96230] s/$qr// does not reuse last pat';
     my $x = 1.1; $x = ${qr//};
     pass 'no assertion failure when upgrading NV to regexp';
 }
+
+sub TIESCALAR{bless[]}
+sub STORE { is ref\pop, "REGEXP", "stored regexp" }
+tie my $t, "";
+$t = ${qr||};
+ok tied $t, 'tied var is still tied after regexp assignment';
+
+bless \my $t2;
+$t2 = ${qr||};
+is ref \$t2, 'main', 'regexp assignment is not maledictory';