Fix assertion failure with $float = $regexp assignment

Commit b9ad13acb3 caused case SVt_REGEXP in sv_upgrade to fall
through to the assertions under case SVt_PVIV that are not relevant to
SVt_REGEXP.

We should really be setting the FAKE flag when actually making a sca-
lar a regexp, rather than in sv_upgrade.  (I will probably need it
there in future commits, too, since it really should be possible for
SVt_PVLVs to hold regular expressions.)

diff --git a/regcomp.c b/regcomp.c
index a3a07b9..6a106f8 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -14178,6 +14178,9 @@ Perl_reg_temp_copy (pTHX_ REGEXP *ret_x, REGEXP *rx)
 
     if (!ret_x)
        ret_x = (REGEXP*) newSV_type(SVt_REGEXP);
+    /* This ensures that SvTHINKFIRST(sv) is true, and hence that
+       sv_force_normal(sv) is called.  */
+    SvFAKE_on(ret_x);
     ret = (struct regexp *)SvANY(ret_x);
     
     (void)ReREFCNT_inc(rx);

diff --git a/sv.c b/sv.c
index 05b54e1..7d67981 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1329,11 +1329,6 @@ Perl_sv_upgrade(pTHX_ register SV *const sv, svtype new_type)
        }
        break;
 
-
-    case SVt_REGEXP:
-       /* This ensures that SvTHINKFIRST(sv) is true, and hence that
-          sv_force_normal_flags(sv) is called.  */
-       SvFAKE_on(sv);
     case SVt_PVIV:
        /* XXX Is this still needed?  Was it ever needed?   Surely as there is
           no route from NV to PVIV, NOK can never be true  */
@@ -1344,6 +1339,7 @@ Perl_sv_upgrade(pTHX_ register SV *const sv, svtype new_type)
     case SVt_PVGV:
     case SVt_PVCV:
     case SVt_PVLV:
+    case SVt_REGEXP:
     case SVt_PVMG:
     case SVt_PVNV:
     case SVt_PV:

diff --git a/t/op/qr.t b/t/op/qr.t
index 29f2773..9d78abf 100644 (file)
--- a/t/op/qr.t
+++ b/t/op/qr.t
@@ -7,7 +7,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan(tests => 20);
+plan(tests => 21);
 
 sub r {
     return qr/Good/;
@@ -67,3 +67,8 @@ like "bar",qr//,'[perl #96230] =~ qr// does not reuse last successful pat';
 $_ = "bar";
 $_ =~ s/${qr||}/baz/;
 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';
+}