For 5.12: saner behaviour for `length`
[p5sagit/p5-mst-13.2.git] / pp.c
diff --git a/pp.c b/pp.c
index 349e91f..6110b4c 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -172,13 +172,7 @@ PP(pp_rv2gv)
                        const char * const name = CopSTASHPV(PL_curcop);
                        gv = newGVgen(name);
                    }
-                   if (SvTYPE(sv) < SVt_RV || SvTYPE(sv) == SVt_NV)
-                       sv_upgrade(sv, SVt_RV);
-                   else if (SvPVX_const(sv)) {
-                       SvPV_free(sv);
-                       SvLEN_set(sv, 0);
-                        SvCUR_set(sv, 0);
-                   }
+                   prepare_SV_for_RV(sv);
                    SvRV_set(sv, (SV*)gv);
                    SvROK_on(sv);
                    SvSETMAGIC(sv);
@@ -419,7 +413,7 @@ PP(pp_prototype)
                        || code == -KEY_exec || code == -KEY_system)
                    goto set;
                if (code == -KEY_mkdir) {
-                   ret = sv_2mortal(newSVpvs("_;$"));
+                   ret = newSVpvs_flags("_;$", SVs_TEMP);
                    goto set;
                }
                if (code == -KEY_readpipe) {
@@ -455,7 +449,7 @@ PP(pp_prototype)
                if (defgv && str[n - 1] == '$')
                    str[n - 1] = '_';
                str[n++] = '\0';
-               ret = sv_2mortal(newSVpvn(str, n - 1));
+               ret = newSVpvn_flags(str, n - 1, SVs_TEMP);
            }
            else if (code)              /* Non-Overridable */
                goto set;
@@ -467,7 +461,7 @@ PP(pp_prototype)
     }
     cv = sv_2cv(TOPs, &stash, &gv, 0);
     if (cv && SvPOK(cv))
-       ret = sv_2mortal(newSVpvn(SvPVX_const(cv), SvCUR(cv)));
+       ret = newSVpvn_flags(SvPVX_const(cv), SvCUR(cv), SVs_TEMP);
   set:
     SETs(ret);
     RETURN;
@@ -536,7 +530,7 @@ S_refto(pTHX_ SV *sv)
        SvREFCNT_inc_void_NN(sv);
     }
     rv = sv_newmortal();
-    sv_upgrade(rv, SVt_RV);
+    sv_upgrade(rv, SVt_IV);
     SvRV_set(rv, sv);
     SvROK_on(rv);
     return rv;
@@ -630,7 +624,7 @@ PP(pp_gelem)
            break;
        case 'N':
            if (strEQ(second_letter, "AME"))
-               sv = newSVpvn(GvNAME(gv), GvNAMELEN(gv));
+               sv = newSVhek(GvNAME_HEK(gv));
            break;
        case 'P':
            if (strEQ(second_letter, "ACKAGE")) {
@@ -2631,7 +2625,7 @@ PP(pp_i_modulo_1)
      /* This is the i_modulo with the workaround for the _moddi3 bug
       * in (at least) glibc 2.2.5 (the PERL_ABS() the workaround).
       * See below for pp_i_modulo. */
-     dVAR; dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
+     dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
      {
          dPOPTOPiirl;
          if (!right)
@@ -3024,25 +3018,35 @@ PP(pp_length)
     dVAR; dSP; dTARGET;
     SV * const sv = TOPs;
 
-    if (SvAMAGIC(sv)) {
-       /* For an overloaded scalar, we can't know in advance if it's going to
-          be UTF-8 or not. Also, we can't call sv_len_utf8 as it likes to
-          cache the length. Maybe that should be a documented feature of it.
+    if (!SvOK(sv) && !SvGMAGICAL(sv)) {
+       /* FIXME - this doesn't allow GMAGIC to return undef for consistency.
+        */
+       SETs(&PL_sv_undef);
+    } else if (SvGAMAGIC(sv)) {
+       /* For an overloaded or magic scalar, we can't know in advance if
+          it's going to be UTF-8 or not. Also, we can't call sv_len_utf8 as
+          it likes to cache the length. Maybe that should be a documented
+          feature of it.
        */
        STRLEN len;
-       const char *const p = SvPV_const(sv, len);
+       const char *const p
+           = sv_2pv_flags(sv, &len,
+                          SV_UNDEF_RETURNS_NULL|SV_CONST_RETURN|SV_GMAGIC);
 
-       if (DO_UTF8(sv)) {
+       if (!p)
+           SETs(&PL_sv_undef);
+       else if (DO_UTF8(sv)) {
            SETi(utf8_length((U8*)p, (U8*)p + len));
        }
        else
            SETi(len);
-
+    } else {
+       /* Neither magic nor overloaded.  */
+       if (DO_UTF8(sv))
+           SETi(sv_len_utf8(sv));
+       else
+           SETi(sv_len(sv));
     }
-    else if (DO_UTF8(sv))
-       SETi(sv_len_utf8(sv));
-    else
-       SETi(sv_len(sv));
     RETURN;
 }
 
@@ -3318,9 +3322,8 @@ PP(pp_index)
           Otherwise I need to avoid calls to sv_pos_u2b(), which (dangerously)
           will trigger magic and overloading again, as will fbm_instr()
        */
-       big = sv_2mortal(newSVpvn(big_p, biglen));
-       if (big_utf8)
-           SvUTF8_on(big);
+       big = newSVpvn_flags(big_p, biglen,
+                            SVs_TEMP | (big_utf8 ? SVf_UTF8 : 0));
        big_p = SvPVX(big);
     }
     if (SvGAMAGIC(little) || (is_index && !SvOK(little))) {
@@ -3332,9 +3335,8 @@ PP(pp_index)
           This is all getting to messy. The API isn't quite clean enough,
           because data access has side effects.
        */
-       little = sv_2mortal(newSVpvn(little_p, llen));
-       if (little_utf8)
-           SvUTF8_on(little);
+       little = newSVpvn_flags(little_p, llen,
+                               SVs_TEMP | (little_utf8 ? SVf_UTF8 : 0));
        little_p = SvPVX(little);
     }
 
@@ -3935,7 +3937,7 @@ PP(pp_aeach)
     dSP;
     AV *array = (AV*)POPs;
     const I32 gimme = GIMME_V;
-    I32 *iterp = Perl_av_iter_p(aTHX_ array);
+    IV *iterp = Perl_av_iter_p(aTHX_ array);
     const IV current = (*iterp)++;
 
     if (current > av_len(array)) {
@@ -4259,8 +4261,8 @@ PP(pp_anonlist)
     const I32 items = SP - MARK;
     SV * const av = (SV *) av_make(items, MARK+1);
     SP = ORIGMARK;             /* av_make() might realloc stack_sp */
-    XPUSHs(sv_2mortal((PL_op->op_flags & OPf_SPECIAL)
-                     ? newRV_noinc(av) : av));
+    mXPUSHs((PL_op->op_flags & OPf_SPECIAL)
+           ? newRV_noinc(av) : av);
     RETURN;
 }
 
@@ -4279,8 +4281,8 @@ PP(pp_anonhash)
        (void)hv_store_ent(hv,key,val,0);
     }
     SP = ORIGMARK;
-    XPUSHs(sv_2mortal((PL_op->op_flags & OPf_SPECIAL)
-                     ? newRV_noinc((SV*) hv) : (SV*)hv));
+    mXPUSHs((PL_op->op_flags & OPf_SPECIAL)
+           ? newRV_noinc((SV*) hv) : (SV*) hv);
     RETURN;
 }
 
@@ -4675,8 +4677,8 @@ PP(pp_split)
        DIE(aTHX_ "panic: pp_split");
     rx = PM_GETRE(pm);
 
-    TAINT_IF((rx->extflags & RXf_PMf_LOCALE) &&
-            (rx->extflags & (RXf_WHITE | RXf_SKIPWHITE)));
+    TAINT_IF((RX_EXTFLAGS(rx) & RXf_PMf_LOCALE) &&
+            (RX_EXTFLAGS(rx) & (RXf_WHITE | RXf_SKIPWHITE)));
 
     RX_MATCH_UTF8_set(rx, do_utf8);
 
@@ -4718,12 +4720,12 @@ PP(pp_split)
     }
     base = SP - PL_stack_base;
     orig = s;
-    if (rx->extflags & RXf_SKIPWHITE) {
+    if (RX_EXTFLAGS(rx) & RXf_SKIPWHITE) {
        if (do_utf8) {
            while (*s == ' ' || is_utf8_space((U8*)s))
                s += UTF8SKIP(s);
        }
-       else if (rx->extflags & RXf_PMf_LOCALE) {
+       else if (RX_EXTFLAGS(rx) & RXf_PMf_LOCALE) {
            while (isSPACE_LC(*s))
                s++;
        }
@@ -4732,13 +4734,13 @@ PP(pp_split)
                s++;
        }
     }
-    if (rx->extflags & PMf_MULTILINE) {
+    if (RX_EXTFLAGS(rx) & PMf_MULTILINE) {
        multiline = 1;
     }
 
     if (!limit)
        limit = maxiters + 2;
-    if (rx->extflags & RXf_WHITE) {
+    if (RX_EXTFLAGS(rx) & RXf_WHITE) {
        while (--limit) {
            m = s;
            /* this one uses 'm' and is a negative test */
@@ -4751,7 +4753,7 @@ PP(pp_split)
                    else
                        m += t;
                }
-            } else if (rx->extflags & RXf_PMf_LOCALE) {
+            } else if (RX_EXTFLAGS(rx) & RXf_PMf_LOCALE) {
                while (m < strend && !isSPACE_LC(*m))
                    ++m;
             } else {
@@ -4761,11 +4763,9 @@ PP(pp_split)
            if (m >= strend)
                break;
 
-           dstr = newSVpvn(s, m-s);
+           dstr = newSVpvn_utf8(s, m-s, do_utf8);
            if (make_mortal)
                sv_2mortal(dstr);
-           if (do_utf8)
-               (void)SvUTF8_on(dstr);
            XPUSHs(dstr);
 
            /* skip the whitespace found last */
@@ -4778,7 +4778,7 @@ PP(pp_split)
            if (do_utf8) {
                while (s < strend && ( *s == ' ' || is_utf8_space((U8*)s) ))
                    s +=  UTF8SKIP(s);
-            } else if (rx->extflags & RXf_PMf_LOCALE) {
+            } else if (RX_EXTFLAGS(rx) & RXf_PMf_LOCALE) {
                while (s < strend && isSPACE_LC(*s))
                    ++s;
             } else {
@@ -4787,23 +4787,21 @@ PP(pp_split)
             }      
        }
     }
-    else if (rx->extflags & RXf_START_ONLY) {
+    else if (RX_EXTFLAGS(rx) & RXf_START_ONLY) {
        while (--limit) {
            for (m = s; m < strend && *m != '\n'; m++)
                ;
            m++;
            if (m >= strend)
                break;
-           dstr = newSVpvn(s, m-s);
+           dstr = newSVpvn_utf8(s, m-s, do_utf8);
            if (make_mortal)
                sv_2mortal(dstr);
-           if (do_utf8)
-               (void)SvUTF8_on(dstr);
            XPUSHs(dstr);
            s = m;
        }
     }
-    else if (rx->extflags & RXf_NULL && !(s >= strend)) {
+    else if (RX_EXTFLAGS(rx) & RXf_NULL && !(s >= strend)) {
         /*
           Pre-extend the stack, either the number of bytes or
           characters in the string or a limited amount, triggered by:
@@ -4823,12 +4821,11 @@ PP(pp_split)
                 /* keep track of how many bytes we skip over */
                 m = s;
                 s += UTF8SKIP(s);
-                dstr = newSVpvn(m, s-m);
+                dstr = newSVpvn_utf8(m, s-m, TRUE);
 
                 if (make_mortal)
                     sv_2mortal(dstr);
 
-                (void)SvUTF8_on(dstr);
                 PUSHs(dstr);
 
                 if (s >= strend)
@@ -4850,26 +4847,24 @@ PP(pp_split)
             }
         }
     }
-    else if (do_utf8 == ((rx->extflags & RXf_UTF8) != 0) &&
-            (rx->extflags & RXf_USE_INTUIT) && !rx->nparens
-            && (rx->extflags & RXf_CHECK_ALL)
-            && !(rx->extflags & RXf_ANCH)) {
-       const int tail = (rx->extflags & RXf_INTUIT_TAIL);
+    else if (do_utf8 == (RX_UTF8(rx) != 0) &&
+            (RX_EXTFLAGS(rx) & RXf_USE_INTUIT) && !RX_NPARENS(rx)
+            && (RX_EXTFLAGS(rx) & RXf_CHECK_ALL)
+            && !(RX_EXTFLAGS(rx) & RXf_ANCH)) {
+       const int tail = (RX_EXTFLAGS(rx) & RXf_INTUIT_TAIL);
        SV * const csv = CALLREG_INTUIT_STRING(rx);
 
-       len = rx->minlenret;
-       if (len == 1 && !(rx->extflags & RXf_UTF8) && !tail) {
+       len = RX_MINLENRET(rx);
+       if (len == 1 && !RX_UTF8(rx) && !tail) {
            const char c = *SvPV_nolen_const(csv);
            while (--limit) {
                for (m = s; m < strend && *m != c; m++)
                    ;
                if (m >= strend)
                    break;
-               dstr = newSVpvn(s, m-s);
+               dstr = newSVpvn_utf8(s, m-s, do_utf8);
                if (make_mortal)
                    sv_2mortal(dstr);
-               if (do_utf8)
-                   (void)SvUTF8_on(dstr);
                XPUSHs(dstr);
                /* The rx->minlen is in characters but we want to step
                 * s ahead by bytes. */
@@ -4884,11 +4879,9 @@ PP(pp_split)
              (m = fbm_instr((unsigned char*)s, (unsigned char*)strend,
                             csv, multiline ? FBMrf_MULTILINE : 0)) )
            {
-               dstr = newSVpvn(s, m-s);
+               dstr = newSVpvn_utf8(s, m-s, do_utf8);
                if (make_mortal)
                    sv_2mortal(dstr);
-               if (do_utf8)
-                   (void)SvUTF8_on(dstr);
                XPUSHs(dstr);
                /* The rx->minlen is in characters but we want to step
                 * s ahead by bytes. */
@@ -4900,7 +4893,7 @@ PP(pp_split)
        }
     }
     else {
-       maxiters += slen * rx->nparens;
+       maxiters += slen * RX_NPARENS(rx);
        while (s < strend && --limit)
        {
            I32 rex_return;
@@ -4911,42 +4904,38 @@ PP(pp_split)
            if (rex_return == 0)
                break;
            TAINT_IF(RX_MATCH_TAINTED(rx));
-           if (RX_MATCH_COPIED(rx) && rx->subbeg != orig) {
+           if (RX_MATCH_COPIED(rx) && RX_SUBBEG(rx) != orig) {
                m = s;
                s = orig;
-               orig = rx->subbeg;
+               orig = RX_SUBBEG(rx);
                s = orig + (m - s);
                strend = s + (strend - m);
            }
-           m = rx->offs[0].start + orig;
-           dstr = newSVpvn(s, m-s);
+           m = RX_OFFS(rx)[0].start + orig;
+           dstr = newSVpvn_utf8(s, m-s, do_utf8);
            if (make_mortal)
                sv_2mortal(dstr);
-           if (do_utf8)
-               (void)SvUTF8_on(dstr);
            XPUSHs(dstr);
-           if (rx->nparens) {
+           if (RX_NPARENS(rx)) {
                I32 i;
-               for (i = 1; i <= (I32)rx->nparens; i++) {
-                   s = rx->offs[i].start + orig;
-                   m = rx->offs[i].end + orig;
+               for (i = 1; i <= (I32)RX_NPARENS(rx); i++) {
+                   s = RX_OFFS(rx)[i].start + orig;
+                   m = RX_OFFS(rx)[i].end + orig;
 
                    /* japhy (07/27/01) -- the (m && s) test doesn't catch
                       parens that didn't match -- they should be set to
                       undef, not the empty string */
                    if (m >= orig && s >= orig) {
-                       dstr = newSVpvn(s, m-s);
+                       dstr = newSVpvn_utf8(s, m-s, do_utf8);
                    }
                    else
                        dstr = &PL_sv_undef;  /* undef, not "" */
                    if (make_mortal)
                        sv_2mortal(dstr);
-                   if (do_utf8)
-                       (void)SvUTF8_on(dstr);
                    XPUSHs(dstr);
                }
            }
-           s = rx->offs[0].end + orig;
+           s = RX_OFFS(rx)[0].end + orig;
        }
     }
 
@@ -4957,11 +4946,9 @@ PP(pp_split)
     /* keep field after final delim? */
     if (s < strend || (iters && origlimit)) {
         const STRLEN l = strend - s;
-       dstr = newSVpvn(s, l);
+       dstr = newSVpvn_utf8(s, l, do_utf8);
        if (make_mortal)
            sv_2mortal(dstr);
-       if (do_utf8)
-           (void)SvUTF8_on(dstr);
        XPUSHs(dstr);
        iters++;
     }