X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doop.c;h=9f0fa6466ac34e8c5ad41b5d743d7f7530f3a335;hb=b6512f489e761186d508cf0b8b7705805cfefc52;hp=14495b1dd4ebe0d4c33c66e32973cc4c6c27d561;hpb=516a5887ee93ac51c15492c01bb2e52bafd5bfaf;p=p5sagit%2Fp5-mst-13.2.git diff --git a/doop.c b/doop.c index 14495b1..9f0fa64 100644 --- a/doop.c +++ b/doop.c @@ -92,7 +92,7 @@ S_do_trans_simple(pTHX_ SV *sv) } STATIC I32 -S_do_trans_count(pTHX_ SV *sv)/* SPC - OK */ +S_do_trans_count(pTHX_ SV *sv) { U8 *s; U8 *send; @@ -130,7 +130,7 @@ S_do_trans_count(pTHX_ SV *sv)/* SPC - OK */ } STATIC I32 -S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */ +S_do_trans_complex(pTHX_ SV *sv) { U8 *s; U8 *send; @@ -141,7 +141,7 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */ I32 grows = PL_op->op_private & OPpTRANS_GROWS; I32 complement = PL_op->op_private & OPpTRANS_COMPLEMENT; I32 del = PL_op->op_private & OPpTRANS_DELETE; - STRLEN len, rlen; + STRLEN len, rlen = 0; short *tbl; I32 ch; @@ -292,7 +292,7 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */ } STATIC I32 -S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */ +S_do_trans_simple_utf8(pTHX_ SV *sv) { U8 *s; U8 *send; @@ -308,7 +308,7 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */ SV** svp = hv_fetch(hv, "NONE", 4, FALSE); UV none = svp ? SvUV(*svp) : 0x7fffffff; UV extra = none + 1; - UV final; + UV final = 0; UV uv; I32 isutf8; U8 hibit = 0; @@ -386,18 +386,15 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */ } SvSETMAGIC(sv); SvUTF8_on(sv); - /* Downgrading just 'cos it will is suspect - NI-S */ - if (!isutf8 && !(PL_hints & HINT_UTF8)) - sv_utf8_downgrade(sv, TRUE); return matches; } STATIC I32 -S_do_trans_count_utf8(pTHX_ SV *sv)/* SPC - OK */ +S_do_trans_count_utf8(pTHX_ SV *sv) { U8 *s; - U8 *start, *send; + U8 *start = 0, *send; I32 matches = 0; STRLEN len; @@ -434,7 +431,7 @@ S_do_trans_count_utf8(pTHX_ SV *sv)/* SPC - OK */ } STATIC I32 -S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */ +S_do_trans_complex_utf8(pTHX_ SV *sv) { U8 *s; U8 *start, *send; @@ -448,7 +445,7 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */ SV** svp = hv_fetch(hv, "NONE", 4, FALSE); UV none = svp ? SvUV(*svp) : 0x7fffffff; UV extra = none + 1; - UV final; + UV final = 0; bool havefinal = FALSE; UV uv; STRLEN len; @@ -590,8 +587,6 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */ SvCUR_set(sv, d - dstart); } SvUTF8_on(sv); - if (!isutf8 && !(PL_hints & HINT_UTF8)) - sv_utf8_downgrade(sv, TRUE); SvSETMAGIC(sv); return matches; @@ -604,9 +599,12 @@ Perl_do_trans(pTHX_ SV *sv) I32 hasutf = (PL_op->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)); - if (SvREADONLY(sv) && !(PL_op->op_private & OPpTRANS_IDENTICAL)) - Perl_croak(aTHX_ PL_no_modify); - + if (SvREADONLY(sv)) { + if (SvFAKE(sv)) + sv_force_normal(sv); + if (SvREADONLY(sv) && !(PL_op->op_private & OPpTRANS_IDENTICAL)) + Perl_croak(aTHX_ PL_no_modify); + } (void)SvPV(sv, len); if (!len) return 0; @@ -648,7 +646,8 @@ Perl_do_join(pTHX_ register SV *sv, SV *del, register SV **mark, register SV **s STRLEN delimlen; STRLEN tmplen; - (void) SvPV(del, delimlen); /* get the delimlen */ + (void) SvPV(del, delimlen); /* stringify and get the delimlen */ + /* SvCUR assumes it's SvPOK() and woe betide you if it's not. */ mark++; len = (items > 0 ? (delimlen * (items - 1) ) : 0); @@ -951,8 +950,14 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv) do_chop(astr,hv_iterval(hv,entry)); return; } - else if (SvREADONLY(sv)) - Perl_croak(aTHX_ PL_no_modify); + else if (SvREADONLY(sv)) { + if (SvFAKE(sv)) { + /* SV is copy-on-write */ + sv_force_normal_flags(sv, 0); + } + if (SvREADONLY(sv)) + Perl_croak(aTHX_ PL_no_modify); + } s = SvPV(sv, len); if (len && !SvPOK(sv)) s = SvPV_force(sv, len); @@ -1021,8 +1026,14 @@ Perl_do_chomp(pTHX_ register SV *sv) count += do_chomp(hv_iterval(hv,entry)); return count; } - else if (SvREADONLY(sv)) - Perl_croak(aTHX_ PL_no_modify); + else if (SvREADONLY(sv)) { + if (SvFAKE(sv)) { + /* SV is copy-on-write */ + sv_force_normal_flags(sv, 0); + } + if (SvREADONLY(sv)) + Perl_croak(aTHX_ PL_no_modify); + } s = SvPV(sv, len); if (s && len) { s += --len; @@ -1083,7 +1094,7 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) char *rsave; bool left_utf = DO_UTF8(left); bool right_utf = DO_UTF8(right); - I32 needlen; + I32 needlen = 0; if (left_utf && !right_utf) sv_utf8_upgrade(right);