-Uusedl on cygwin

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

diff --git a/pp.c b/pp.c
index 374f355..d940d10 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -218,12 +218,14 @@ PP(pp_rv2gv)
 
 /* Helper function for pp_rv2sv and pp_rv2av  */
 GV *
-Perl_softref2xv(pTHX_ SV *const sv, const char *const what, const U32 type,
-               SV ***spp)
+Perl_softref2xv(pTHX_ SV *const sv, const char *const what,
+               const svtype type, SV ***spp)
 {
     dVAR;
     GV *gv;
 
+    PERL_ARGS_ASSERT_SOFTREF2XV;
+
     if (PL_op->op_private & HINT_STRICT_REFS) {
        if (SvOK(sv))
            Perl_die(aTHX_ PL_no_symref_sv, sv, what);
@@ -509,6 +511,8 @@ S_refto(pTHX_ SV *sv)
     dVAR;
     SV* rv;
 
+    PERL_ARGS_ASSERT_REFTO;
+
     if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y') {
        if (LvTARGLEN(sv))
            vivify_defelem(sv);
@@ -3018,25 +3022,33 @@ 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 (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 if (SvOK(sv)) {
+       /* Neither magic nor overloaded.  */
+       if (DO_UTF8(sv))
+           SETi(sv_len_utf8(sv));
+       else
+           SETi(sv_len(sv));
+    } else {
+       SETs(&PL_sv_undef);
     }
-    else if (DO_UTF8(sv))
-       SETi(sv_len_utf8(sv));
-    else
-       SETi(sv_len(sv));
     RETURN;
 }
 
@@ -3166,7 +3178,9 @@ PP(pp_substr)
                repl = SvPV_const(repl_sv_copy, repl_len);
                repl_is_utf8 = DO_UTF8(repl_sv_copy) && SvCUR(sv);
            }
-           sv_insert(sv, pos, rem, repl, repl_len);
+           if (!SvOK(sv))
+               sv_setpvs(sv, "");
+           sv_insert_flags(sv, pos, rem, repl, repl_len, 0);
            if (repl_is_utf8)
                SvUTF8_on(sv);
            if (repl_sv_copy)
@@ -3185,7 +3199,7 @@ PP(pp_substr)
                else if (SvOK(sv))      /* is it defined ? */
                    (void)SvPOK_only_UTF8(sv);
                else
-                   sv_setpvn(sv,"",0); /* avoid lexical reincarnation */
+                   sv_setpvs(sv, ""); /* avoid lexical reincarnation */
            }
 
            if (SvTYPE(TARG) < SVt_PVLV) {
@@ -3520,6 +3534,8 @@ PP(pp_ucfirst)
     if (SvOK(source)) {
        s = (const U8*)SvPV_nomg_const(source, slen);
     } else {
+       if (ckWARN(WARN_UNINITIALIZED))
+           report_uninit(source);
        s = (const U8*)"";
        slen = 0;
     }
@@ -3644,6 +3660,8 @@ PP(pp_uc)
        if (SvOK(source)) {
            s = (const U8*)SvPV_nomg_const(source, len);
        } else {
+           if (ckWARN(WARN_UNINITIALIZED))
+               report_uninit(source);
            s = (const U8*)"";
            len = 0;
        }
@@ -3744,6 +3762,8 @@ PP(pp_lc)
        if (SvOK(source)) {
            s = (const U8*)SvPV_nomg_const(source, len);
        } else {
+           if (ckWARN(WARN_UNINITIALIZED))
+               report_uninit(source);
            s = (const U8*)"";
            len = 0;
        }
@@ -4654,7 +4674,7 @@ PP(pp_split)
     I32 base;
     const I32 gimme = GIMME_V;
     const I32 oldsave = PL_savestack_ix;
-    I32 make_mortal = 1;
+    U32 make_mortal = SVs_TEMP;
     bool multiline = 0;
     MAGIC *mg = NULL;
 
@@ -4753,9 +4773,8 @@ PP(pp_split)
            if (m >= strend)
                break;
 
-           dstr = newSVpvn_utf8(s, m-s, do_utf8);
-           if (make_mortal)
-               sv_2mortal(dstr);
+           dstr = newSVpvn_flags(s, m-s,
+                                 (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
            XPUSHs(dstr);
 
            /* skip the whitespace found last */
@@ -4784,9 +4803,8 @@ PP(pp_split)
            m++;
            if (m >= strend)
                break;
-           dstr = newSVpvn_utf8(s, m-s, do_utf8);
-           if (make_mortal)
-               sv_2mortal(dstr);
+           dstr = newSVpvn_flags(s, m-s,
+                                 (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
            XPUSHs(dstr);
            s = m;
        }
@@ -4811,10 +4829,7 @@ PP(pp_split)
                 /* keep track of how many bytes we skip over */
                 m = s;
                 s += UTF8SKIP(s);
-                dstr = newSVpvn_utf8(m, s-m, TRUE);
-
-                if (make_mortal)
-                    sv_2mortal(dstr);
+                dstr = newSVpvn_flags(m, s-m, SVf_UTF8 | make_mortal);
 
                 PUSHs(dstr);
 
@@ -4852,9 +4867,8 @@ PP(pp_split)
                    ;
                if (m >= strend)
                    break;
-               dstr = newSVpvn_utf8(s, m-s, do_utf8);
-               if (make_mortal)
-                   sv_2mortal(dstr);
+               dstr = newSVpvn_flags(s, m-s,
+                                     (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
                XPUSHs(dstr);
                /* The rx->minlen is in characters but we want to step
                 * s ahead by bytes. */
@@ -4869,9 +4883,8 @@ PP(pp_split)
              (m = fbm_instr((unsigned char*)s, (unsigned char*)strend,
                             csv, multiline ? FBMrf_MULTILINE : 0)) )
            {
-               dstr = newSVpvn_utf8(s, m-s, do_utf8);
-               if (make_mortal)
-                   sv_2mortal(dstr);
+               dstr = newSVpvn_flags(s, m-s,
+                                     (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
                XPUSHs(dstr);
                /* The rx->minlen is in characters but we want to step
                 * s ahead by bytes. */
@@ -4902,9 +4915,8 @@ PP(pp_split)
                strend = s + (strend - m);
            }
            m = RX_OFFS(rx)[0].start + orig;
-           dstr = newSVpvn_utf8(s, m-s, do_utf8);
-           if (make_mortal)
-               sv_2mortal(dstr);
+           dstr = newSVpvn_flags(s, m-s,
+                                 (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
            XPUSHs(dstr);
            if (RX_NPARENS(rx)) {
                I32 i;
@@ -4916,12 +4928,12 @@ PP(pp_split)
                       parens that didn't match -- they should be set to
                       undef, not the empty string */
                    if (m >= orig && s >= orig) {
-                       dstr = newSVpvn_utf8(s, m-s, do_utf8);
+                       dstr = newSVpvn_flags(s, m-s,
+                                            (do_utf8 ? SVf_UTF8 : 0)
+                                             | make_mortal);
                    }
                    else
                        dstr = &PL_sv_undef;  /* undef, not "" */
-                   if (make_mortal)
-                       sv_2mortal(dstr);
                    XPUSHs(dstr);
                }
            }
@@ -4936,9 +4948,7 @@ PP(pp_split)
     /* keep field after final delim? */
     if (s < strend || (iters && origlimit)) {
         const STRLEN l = strend - s;
-       dstr = newSVpvn_utf8(s, l, do_utf8);
-       if (make_mortal)
-           sv_2mortal(dstr);
+       dstr = newSVpvn_flags(s, l, (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
        XPUSHs(dstr);
        iters++;
     }