give REGEXP SVs the POK flag again

[perl5.git] / sv.c

diff --git a/sv.c b/sv.c
index 70ad03e..887c9e7 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1462,9 +1462,7 @@ Perl_sv_upgrade(pTHX_ SV *const sv, svtype new_type)
            SvSTASH_set(io, MUTABLE_HV(SvREFCNT_inc(GvHV(iogv))));
            IoPAGE_LEN(sv) = 60;
        }
-       if (UNLIKELY(new_type == SVt_REGEXP))
-           sv->sv_u.svu_rx = (regexp *)new_body;
-       else if (old_type < SVt_PV) {
+       if (old_type < SVt_PV) {
            /* referent will be NULL unless the old type was SVt_IV emulating
               SVt_RV */
            sv->sv_u.svu_rv = referent;
@@ -2463,7 +2461,7 @@ Perl_sv_2iv_flags(pTHX_ SV *const sv, const I32 flags)
 
           Regexps have no SvIVX and SvNVX fields.
        */
-       assert(isREGEXP(sv) || SvPOKp(sv));
+       assert(SvPOKp(sv));
        {
            UV value;
            const char * const ptr =
@@ -2551,7 +2549,7 @@ Perl_sv_2uv_flags(pTHX_ SV *const sv, const I32 flags)
        /* FBMs use the space for SvIVX and SvNVX for other purposes, and use
           the same flag bit as SVf_IVisUV, so must not let them cache IVs.  
           Regexps have no SvIVX and SvNVX fields. */
-       assert(isREGEXP(sv) || SvPOKp(sv));
+       assert(SvPOKp(sv));
        {
            UV value;
            const char * const ptr =
@@ -2627,7 +2625,6 @@ Perl_sv_2nv_flags(pTHX_ SV *const sv, const I32 flags)
            return SvNVX(sv);
        if (SvPOKp(sv) && !SvIOKp(sv)) {
            ptr = SvPVX_const(sv);
-         grokpv:
            if (!SvIOKp(sv) && ckWARN(WARN_NUMERIC) &&
                !grok_number(ptr, SvCUR(sv), NULL))
                not_a_number(sv);
@@ -2642,10 +2639,6 @@ Perl_sv_2nv_flags(pTHX_ SV *const sv, const I32 flags)
         if (SvROK(sv)) {
            goto return_rok;
        }
-       if (isREGEXP(sv)) {
-           ptr = RX_WRAPPED((REGEXP *)sv);
-           goto grokpv;
-       }
        assert(SvTYPE(sv) >= SVt_PVMG);
        /* This falls through to the report_uninit near the end of the
           function. */
@@ -3191,10 +3184,6 @@ Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags)
            *lp = SvCUR(buffer);
        return SvPVX(buffer);
     }
-    else if (isREGEXP(sv)) {
-       if (lp) *lp = RX_WRAPLEN((REGEXP *)sv);
-       return RX_WRAPPED((REGEXP *)sv);
-    }
     else {
        if (lp)
            *lp = 0;
@@ -4447,15 +4436,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags)
     case SVt_REGEXP:
       upgregexp:
        if (dtype < SVt_REGEXP)
-       {
-           if (dtype >= SVt_PV) {
-               SvPV_free(dstr);
-               SvPV_set(dstr, 0);
-               SvLEN_set(dstr, 0);
-               SvCUR_set(dstr, 0);
-           }
            sv_upgrade(dstr, SVt_REGEXP);
-       }
        break;
 
        case SVt_INVLIST:
@@ -5337,7 +5318,7 @@ Perl_sv_force_normal_flags(pTHX_ SV *const sv, const U32 flags)
        const svtype new_type =
          islv ? SVt_NULL : SvMAGIC(sv) || SvSTASH(sv) ? SVt_PVMG : SVt_PV;
        SV *const temp = newSV_type(new_type);
-       regexp *const temp_p = ReANY((REGEXP *)sv);
+       regexp *old_rx_body;
 
        if (new_type == SVt_PVMG) {
            SvMAGIC_set(temp, SvMAGIC(sv));
@@ -5345,15 +5326,26 @@ Perl_sv_force_normal_flags(pTHX_ SV *const sv, const U32 flags)
            SvSTASH_set(temp, SvSTASH(sv));
            SvSTASH_set(sv, NULL);
        }
-       if (!islv) SvCUR_set(temp, SvCUR(sv));
-       /* Remember that SvPVX is in the head, not the body.  But
-          RX_WRAPPED is in the body. */
+       if (!islv)
+            SvCUR_set(temp, SvCUR(sv));
+       /* Remember that SvPVX is in the head, not the body. */
        assert(ReANY((REGEXP *)sv)->mother_re);
+
+        if (islv) {
+            /* LV-as-regex has sv->sv_any pointing to an XPVLV body,
+             * whose xpvlenu_rx field points to the regex body */
+            XPV *xpv = (XPV*)(SvANY(sv));
+            old_rx_body = xpv->xpv_len_u.xpvlenu_rx;
+            xpv->xpv_len_u.xpvlenu_rx = NULL;
+        }
+        else
+            old_rx_body = ReANY((REGEXP *)sv);
+
        /* Their buffer is already owned by someone else. */
        if (flags & SV_COW_DROP_PV) {
            /* SvLEN is already 0.  For SVt_REGEXP, we have a brand new
-              zeroed body.  For SVt_PVLV, it should have been set to 0
-              before turning into a regexp. */
+              zeroed body.  For SVt_PVLV, we zeroed it above (len field
+               a union with xpvlenu_rx) */
            assert(!SvLEN(islv ? sv : temp));
            sv->sv_u.svu_pv = 0;
        }
@@ -5374,8 +5366,7 @@ Perl_sv_force_normal_flags(pTHX_ SV *const sv, const U32 flags)
 
        SvFLAGS(temp) &= ~(SVTYPEMASK);
        SvFLAGS(temp) |= SVt_REGEXP|SVf_FAKE;
-       SvANY(temp) = temp_p;
-       temp->sv_u.svu_rx = (regexp *)temp_p;
+       SvANY(temp) = old_rx_body;
 
        SvREFCNT_dec_NN(temp);
     }
@@ -14229,7 +14220,6 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
            case SVt_REGEXP:
              duprex:
                /* FIXME for plugins */
-               dstr->sv_u.svu_rx = ((REGEXP *)dstr)->sv_any;
                re_dup_guts((REGEXP*) sstr, (REGEXP*) dstr, param);
                break;
            case SVt_PVLV: