X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=d940d104c135e8c5654fbf7428111c34aac18a48;hb=20e8a3a35e61c7fcc6a4173969d7b685e762aef7;hp=374f3550e2226790e9fc2c79aadaed1e29dbebc7;hpb=5186cc1225228b10ef0f8c5cf7d34fbcf0e84174;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp.c b/pp.c index 374f355..d940d10 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); @@ -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++; }