X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=5b09c082d10d1376103b8ff5d2968bdcb3e83e6a;hb=291f766ec79ed2f8f09e116381515c07bad45726;hp=6026f24dad164f117bf1e77ad00be04c6ccece63;hpb=3c8556c3bff92f6c755a00c0166f795d7176b75d;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp.c b/pp.c index 6026f24..5b09c08 100644 --- 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); @@ -2625,7 +2629,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) @@ -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; } @@ -3520,6 +3532,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 +3658,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 +3760,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 +4672,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 +4771,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 +4801,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 +4827,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 +4865,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 +4881,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 +4913,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 +4926,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 +4946,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++; }