X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doop.c;h=7acad602c49d32a8bc672afb9f302de58ff515ce;hb=3b0e0cb610a437b422e9557a50cdb439557976dd;hp=3cd8f07b206bf1147ce9916485105137646e4b29;hpb=ba210ebec161cde003bc967e8e460c72f71fb70c;p=p5sagit%2Fp5-mst-13.2.git diff --git a/doop.c b/doop.c index 3cd8f07..7acad60 100644 --- a/doop.c +++ b/doop.c @@ -36,7 +36,6 @@ STATIC I32 S_do_trans_simple(pTHX_ SV *sv) { - dTHR; U8 *s; U8 *d; U8 *send; @@ -77,13 +76,10 @@ S_do_trans_simple(pTHX_ SV *sv) ulen = 1; /* Need to check this, otherwise 128..255 won't match */ - c = utf8_to_uv_chk(s, send - s, &ulen, 0); + c = utf8_to_uv(s, send - s, &ulen, 0); if (c < 0x100 && (ch = tbl[(short)c]) >= 0) { matches++; - if (ch < 0x80) - *d++ = ch; - else - d = uv_to_utf8(d,ch); + d = uv_to_utf8(d,ch); s += ulen; } else { /* No match -> copy */ @@ -102,7 +98,6 @@ S_do_trans_simple(pTHX_ SV *sv) STATIC I32 S_do_trans_count(pTHX_ SV *sv)/* SPC - OK */ { - dTHR; U8 *s; U8 *send; I32 matches = 0; @@ -125,7 +120,7 @@ S_do_trans_count(pTHX_ SV *sv)/* SPC - OK */ STRLEN ulen; ulen = 1; if (hasutf) - c = utf8_to_uv_chk(s, send - s, &ulen, 0); + c = utf8_to_uv(s, send - s, &ulen, 0); else c = *s; if (c < 0x100 && tbl[c] >= 0) @@ -140,10 +135,10 @@ S_do_trans_count(pTHX_ SV *sv)/* SPC - OK */ STATIC I32 S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */ { - dTHR; U8 *s; U8 *send; U8 *d; + U8 *dstart; I32 hasutf = SvUTF8(sv); I32 matches = 0; STRLEN len; @@ -157,7 +152,9 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */ s = (U8*)SvPV(sv, len); send = s + len; - d = s; + Newz(0, d, len*2+1, U8); + dstart = d; + if (PL_op->op_private & OPpTRANS_SQUASH) { U8* p = send; @@ -168,9 +165,7 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */ if ((ch = tbl[*s]) >= 0) { *d = ch; matches++; - if (p == d - 1 && *p == *d) - matches--; - else + if (p != d - 1 || *p != *d) p = d++; } else if (ch == -1) /* -1 is unmapped character */ @@ -181,32 +176,43 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */ } else { while (s < send) { + UV comp; if (hasutf && *s & 0x80) - s += UTF8SKIP(s); - else { - if ((ch = tbl[*s]) >= 0) { - *d = ch; - matches++; - d++; - } - else if (ch == -1) /* -1 is unmapped character */ - *d++ = *s; /* -2 is delete character */ - s++; - } + comp = utf8_to_uv_simple(s, NULL); + else + comp = *s; + + ch = tbl[comp]; + + if (ch == -1) { /* -1 is unmapped character */ + ch = comp; + matches--; + } + + if (ch >= 0) + d = uv_to_utf8(d, ch); + + matches++; + + s += hasutf && *s & 0x80 ? UNISKIP(*s) : 1; + } } - matches += send - d; /* account for disappeared chars */ + *d = '\0'; - SvCUR_set(sv, d - (U8*)SvPVX(sv)); - SvSETMAGIC(sv); + sv_setpvn(sv, (const char*)dstart, d - dstart); + Safefree(dstart); + if (hasutf) + SvUTF8_on(sv); + SvSETMAGIC(sv); return matches; + } STATIC I32 S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */ { - dTHR; U8 *s; U8 *send; U8 *d; @@ -277,7 +283,6 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */ STATIC I32 S_do_trans_count_utf8(pTHX_ SV *sv)/* SPC - OK */ { - dTHR; U8 *s; U8 *send; I32 matches = 0; @@ -306,7 +311,6 @@ S_do_trans_count_utf8(pTHX_ SV *sv)/* SPC - OK */ STATIC I32 S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */ { - dTHR; U8 *s; U8 *send; U8 *d; @@ -364,7 +368,7 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */ } else if (uv == none) { /* "none" is unmapped character */ STRLEN ulen; - *d++ = (U8)utf8_to_uv_chk(s, send - s, &ulen, 0); + *d++ = (U8)utf8_to_uv(s, send - s, &ulen, 0); s += ulen; puv = 0xfeedface; continue; @@ -405,7 +409,7 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */ } else if (uv == none) { /* "none" is unmapped character */ STRLEN ulen; - *d++ = (U8)utf8_to_uv_chk(s, send - s, &ulen, 0); + *d++ = (U8)utf8_to_uv(s, send - s, &ulen, 0); s += ulen; continue; } @@ -433,7 +437,6 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */ I32 Perl_do_trans(pTHX_ SV *sv) { - dTHR; STRLEN len; I32 hasutf = (PL_op->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)); @@ -550,9 +553,8 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) if (size < 1 || (size & (size-1))) /* size < 1 or not a power of two */ Perl_croak(aTHX_ "Illegal number of bits in vec"); - if (SvUTF8(sv)) { + if (SvUTF8(sv)) (void) Perl_sv_utf8_downgrade(aTHX_ sv, TRUE); - } offset *= size; /* turn into bit offset */ len = (offset + size + 7) / 8; /* required number of bytes */ @@ -585,7 +587,6 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) } #ifdef UV_IS_QUAD else if (size == 64) { - dTHR; if (ckWARN(WARN_PORTABLE)) Perl_warner(aTHX_ WARN_PORTABLE, "Bit vector size > 32 non-portable"); @@ -655,7 +656,6 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) s[offset + 3]; #ifdef UV_IS_QUAD else if (size == 64) { - dTHR; if (ckWARN(WARN_PORTABLE)) Perl_warner(aTHX_ WARN_PORTABLE, "Bit vector size > 32 non-portable"); @@ -743,7 +743,6 @@ Perl_do_vecset(pTHX_ SV *sv) } #ifdef UV_IS_QUAD else if (size == 64) { - dTHR; if (ckWARN(WARN_PORTABLE)) Perl_warner(aTHX_ WARN_PORTABLE, "Bit vector size > 32 non-portable"); @@ -766,7 +765,6 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv) { STRLEN len; char *s; - dTHR; if (SvTYPE(sv) == SVt_PVAV) { register I32 i; @@ -828,7 +826,6 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv) I32 Perl_do_chomp(pTHX_ register SV *sv) { - dTHR; register I32 count; STRLEN len; char *s; @@ -906,7 +903,6 @@ Perl_do_chomp(pTHX_ register SV *sv) void Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) { - dTHR; /* just for taint */ #ifdef LIBERAL register long *dl; register long *ll; @@ -927,7 +923,7 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) if (left_utf && !right_utf) sv_utf8_upgrade(right); - if (!left_utf && right_utf) + else if (!left_utf && right_utf) sv_utf8_upgrade(left); if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv))) @@ -969,10 +965,10 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) switch (optype) { case OP_BIT_AND: while (lulen && rulen) { - luc = utf8_to_uv_chk((U8*)lc, lulen, &ulen, 0); + luc = utf8_to_uv((U8*)lc, lulen, &ulen, UTF8_ALLOW_ANYUV); lc += ulen; lulen -= ulen; - ruc = utf8_to_uv_chk((U8*)rc, rulen, &ulen, 0); + ruc = utf8_to_uv((U8*)rc, rulen, &ulen, UTF8_ALLOW_ANYUV); rc += ulen; rulen -= ulen; duc = luc & ruc; @@ -984,10 +980,10 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) break; case OP_BIT_XOR: while (lulen && rulen) { - luc = utf8_to_uv_chk((U8*)lc, lulen, &ulen, 0); + luc = utf8_to_uv((U8*)lc, lulen, &ulen, UTF8_ALLOW_ANYUV); lc += ulen; lulen -= ulen; - ruc = utf8_to_uv_chk((U8*)rc, rulen, &ulen, 0); + ruc = utf8_to_uv((U8*)rc, rulen, &ulen, UTF8_ALLOW_ANYUV); rc += ulen; rulen -= ulen; duc = luc ^ ruc; @@ -996,10 +992,10 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) goto mop_up_utf; case OP_BIT_OR: while (lulen && rulen) { - luc = utf8_to_uv_chk((U8*)lc, lulen, &ulen, 0); + luc = utf8_to_uv((U8*)lc, lulen, &ulen, UTF8_ALLOW_ANYUV); lc += ulen; lulen -= ulen; - ruc = utf8_to_uv_chk((U8*)rc, rulen, &ulen, 0); + ruc = utf8_to_uv((U8*)rc, rulen, &ulen, UTF8_ALLOW_ANYUV); rc += ulen; rulen -= ulen; duc = luc | ruc;