Fix regexec.c so $^N and $+ are correctly updated so that they work properly inside...

[p5sagit/p5-mst-13.2.git] / sv.c

diff --git a/sv.c b/sv.c
index c50eef0..a9bdfd2 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1397,27 +1397,18 @@ wrapper instead.
 int
 Perl_sv_backoff(pTHX_ register SV *sv)
 {
+    STRLEN delta;
+    const char * const s = SvPVX_const(sv);
     PERL_UNUSED_CONTEXT;
     assert(SvOOK(sv));
     assert(SvTYPE(sv) != SVt_PVHV);
     assert(SvTYPE(sv) != SVt_PVAV);
-    if (SvIVX(sv)) {
-       const char * const s = SvPVX_const(sv);
-#ifdef DEBUGGING
-       /* Validate the preceding buffer's sentinels to verify that no-one is
-          using it.  */
-       const U8 *p = (const U8*) s;
-       const U8 *const real_start = p - SvIVX(sv);
-       while (p > real_start) {
-           --p;
-           assert (*p == (U8)PTR2UV(p));
-       }
-#endif
-       SvLEN_set(sv, SvLEN(sv) + SvIVX(sv));
-       SvPV_set(sv, SvPVX(sv) - SvIVX(sv));
-       SvIV_set(sv, 0);
-       Move(s, SvPVX(sv), SvCUR(sv)+1, char);
-    }
+
+    SvOOK_offset(sv, delta);
+    
+    SvLEN_set(sv, SvLEN(sv) + delta);
+    SvPV_set(sv, SvPVX(sv) - delta);
+    Move(s, SvPVX(sv), SvCUR(sv)+1, char);
     SvFLAGS(sv) &= ~SVf_OOK;
     return 0;
 }
@@ -1655,7 +1646,7 @@ S_not_a_number(pTHX_ SV *sv)
      const char *pv;
 
      if (DO_UTF8(sv)) {
-          dsv = sv_2mortal(newSVpvs(""));
+          dsv = newSVpvs_flags("", SVs_TEMP);
           pv = sv_uni_display(dsv, sv, 10, 0);
      } else {
          char *d = tmpbuf;
@@ -3779,7 +3770,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
            SvNV_set(dstr, SvNVX(sstr));
        }
        if (sflags & SVp_IOK) {
-           SvOOK_off(dstr);
            SvIV_set(dstr, SvIVX(sstr));
            /* Must do this otherwise some other overloaded use of 0x80000000
               gets confused. I guess SVpbm_VALID */
@@ -4218,7 +4208,13 @@ refer to the same chunk of data.
 void
 Perl_sv_chop(pTHX_ register SV *sv, register const char *ptr)
 {
-    register STRLEN delta;
+    STRLEN delta;
+    STRLEN old_delta;
+    U8 *p;
+#ifdef DEBUGGING
+    const U8 *real_start;
+#endif
+
     if (!ptr || !SvPOKp(sv))
        return;
     delta = ptr - SvPVX_const(sv);
@@ -4228,8 +4224,6 @@ Perl_sv_chop(pTHX_ register SV *sv, register const char *ptr)
     }
     assert(ptr > SvPVX_const(sv));
     SV_CHECK_THINKFIRST(sv);
-    if (SvTYPE(sv) < SVt_PVIV)
-       sv_upgrade(sv,SVt_PVIV);
 
     if (!SvOOK(sv)) {
        if (!SvLEN(sv)) { /* make copy of shared string */
@@ -4239,27 +4233,38 @@ Perl_sv_chop(pTHX_ register SV *sv, register const char *ptr)
            Move(pvx,SvPVX(sv),len,char);
            *SvEND(sv) = '\0';
        }
-       SvIV_set(sv, 0);
-       /* Same SvOOK_on but SvOOK_on does a SvIOK_off
-          and we do that anyway inside the SvNIOK_off
-       */
        SvFLAGS(sv) |= SVf_OOK;
+       old_delta = 0;
+    } else {
+       SvOOK_offset(sv, old_delta);
     }
-    SvNIOK_off(sv);
     SvLEN_set(sv, SvLEN(sv) - delta);
     SvCUR_set(sv, SvCUR(sv) - delta);
     SvPV_set(sv, SvPVX(sv) + delta);
-    SvIV_set(sv, SvIVX(sv) + delta);
+
+    p = (U8 *)SvPVX_const(sv);
+
+    delta += old_delta;
+
 #ifdef DEBUGGING
-    {
-       /* Fill the preceding buffer with sentinals to verify that no-one is
-          using it.  */
-       U8 *p = (U8*) SvPVX(sv);
-       const U8 *const real_start = p - SvIVX(sv);
-       while (p > real_start) {
-           --p;
-           *p = (U8)PTR2UV(p);
-       }
+    real_start = p - delta;
+#endif
+
+    assert(delta);
+    if (delta < 0x100) {
+       *--p = (U8) delta;
+    } else {
+       *--p = 0;
+       p -= sizeof(STRLEN);
+       Copy((U8*)&delta, p, sizeof(STRLEN), U8);
+    }
+
+#ifdef DEBUGGING
+    /* Fill the preceding buffer with sentinals to verify that no-one is
+       using it.  */
+    while (p > real_start) {
+       --p;
+       *p = (U8)PTR2UV(p);
     }
 #endif
 }
@@ -5278,13 +5283,15 @@ Perl_sv_clear(pTHX_ register SV *sv)
     case SVt_PVMG:
     case SVt_PVNV:
     case SVt_PVIV:
+    case SVt_PV:
       freescalar:
        /* Don't bother with SvOOK_off(sv); as we're only going to free it.  */
        if (SvOOK(sv)) {
-           SvPV_set(sv, SvPVX_mutable(sv) - SvIVX(sv));
+           STRLEN offset;
+           SvOOK_offset(sv, offset);
+           SvPV_set(sv, SvPVX_mutable(sv) - offset);
            /* Don't even bother with turning off the OOK flag.  */
        }
-    case SVt_PV:
        if (SvROK(sv)) {
            SV * const target = SvRV(sv);
            if (SvWEAKREF(sv))
@@ -10912,7 +10919,7 @@ do_mark_cloneable_stash(pTHX_ SV *sv)
            ENTER;
            SAVETMPS;
            PUSHMARK(SP);
-           XPUSHs(sv_2mortal(newSVhek(hvname)));
+           mXPUSHs(newSVhek(hvname));
            PUTBACK;
            call_sv((SV*)GvCV(cloner), G_SCALAR);
            SPAGAIN;
@@ -11667,7 +11674,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
            ENTER;
            SAVETMPS;
            PUSHMARK(SP);
-           XPUSHs(sv_2mortal(newSVhek(HvNAME_HEK(stash))));
+           mXPUSHs(newSVhek(HvNAME_HEK(stash)));
            PUTBACK;
            call_sv((SV*)GvCV(cloner), G_DISCARD);
            FREETMPS;
@@ -11783,8 +11790,9 @@ Perl_sv_cat_decode(pTHX_ SV *dsv, SV *encoding,
        XPUSHs(encoding);
        XPUSHs(dsv);
        XPUSHs(ssv);
-       XPUSHs(offsv = sv_2mortal(newSViv(*offset)));
-       XPUSHs(newSVpvn_flags(tstr, tlen, SVs_TEMP));
+       offsv = newSViv(*offset);
+       mXPUSHs(offsv);
+       mXPUSHp(tstr, tlen);
        PUTBACK;
        call_method("cat_decode", G_SCALAR);
        SPAGAIN;
@@ -12212,7 +12220,7 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
     case OP_SCHOMP:
     case OP_CHOMP:
        if (SvROK(PL_rs) && uninit_sv == SvRV(PL_rs))
-           return sv_2mortal(newSVpvs("${$/}"));
+           return newSVpvs_flags("${$/}", SVs_TEMP);
        /*FALLTHROUGH*/
 
     default: