I32 matches = 0;
STRLEN len;
short *tbl;
+ I32 complement = PL_op->op_private & OPpTRANS_COMPLEMENT;
tbl = (short*)cPVOP->op_pv;
if (!tbl)
UV c;
STRLEN ulen;
c = utf8_to_uv(s, send - s, &ulen, 0);
- if (c < 0x100 && tbl[c] >= 0)
+ if (c < 0x100) {
+ if (tbl[c] >= 0)
+ matches++;
+ } else if (complement)
matches++;
s += ulen;
}
I32 isutf8;
I32 matches = 0;
I32 grows = PL_op->op_private & OPpTRANS_GROWS;
- STRLEN len;
+ I32 complement = PL_op->op_private & OPpTRANS_COMPLEMENT;
+ I32 del = PL_op->op_private & OPpTRANS_DELETE;
+ STRLEN len, rlen;
short *tbl;
I32 ch;
else
d = s;
dstart = d;
+ if (complement && !del)
+ rlen = tbl[0x100];
+
+#ifdef MACOS_TRADITIONAL
+#define comp CoMP /* "comp" is a keyword in some compilers ... */
+#endif
if (PL_op->op_private & OPpTRANS_SQUASH) {
- U8* p = send;
UV pch = 0xfeedface;
while (s < send) {
STRLEN len;
UV comp = utf8_to_uv_simple(s, &len);
- if (comp > 0xff) { /* always unmapped */
- Copy(s, d, len, U8);
- d += len;
+ if (comp > 0xff) {
+ if (!complement) {
+ Copy(s, d, len, U8);
+ d += len;
+ }
+ else {
+ matches++;
+ if (!del) {
+ ch = (comp - 0x100 < rlen) ?
+ tbl[comp+1] : tbl[0x100+rlen];
+ if (ch != pch) {
+ d = uv_to_utf8(d, ch);
+ pch = ch;
+ }
+ s += len;
+ continue;
+ }
+ }
}
else if ((ch = tbl[comp]) >= 0) {
matches++;
while (s < send) {
STRLEN len;
UV comp = utf8_to_uv_simple(s, &len);
- if (comp > 0xff) { /* always unmapped */
- Copy(s, d, len, U8);
- d += len;
+ if (comp > 0xff) {
+ if (!complement) {
+ Copy(s, d, len, U8);
+ d += len;
+ }
+ else {
+ matches++;
+ if (!del) {
+ if (comp - 0x100 < rlen)
+ d = uv_to_utf8(d, tbl[comp+1]);
+ else
+ d = uv_to_utf8(d, tbl[0x100+rlen]);
+ }
+ }
}
else if ((ch = tbl[comp]) >= 0) {
d = uv_to_utf8(d, ch);
dend = dstart + nlen;
}
}
- if (grows) {
+ if (grows || hibit) {
sv_setpvn(sv, (char*)dstart, d - dstart);
Safefree(dstart);
+ if (grows && hibit)
+ Safefree(start);
}
else {
*d = '\0';
}
SvSETMAGIC(sv);
SvUTF8_on(sv);
- if (hibit)
- Safefree(start);
if (!isutf8 && !(PL_hints & HINT_UTF8))
sv_utf8_downgrade(sv, TRUE);
}
if (uv < none) {
matches++;
+ s += UTF8SKIP(s);
if (uv != puv) {
d = uv_to_utf8(d, uv);
puv = uv;
}
- s += UTF8SKIP(s);
continue;
}
else if (uv == none) { /* "none" is unmapped character */
}
else if (uv == extra && !del) {
matches++;
+ s += UTF8SKIP(s);
if (uv != puv) {
d = uv_to_utf8(d, final);
puv = final;
}
- s += UTF8SKIP(s);
continue;
}
matches++; /* "none+1" is delete character */
}
if (uv < none) {
matches++;
- d = uv_to_utf8(d, uv);
s += UTF8SKIP(s);
+ d = uv_to_utf8(d, uv);
continue;
}
else if (uv == none) { /* "none" is unmapped character */
}
else if (uv == extra && !del) {
matches++;
- d = uv_to_utf8(d, final);
s += UTF8SKIP(s);
+ d = uv_to_utf8(d, final);
continue;
}
matches++; /* "none+1" is delete character */
s += UTF8SKIP(s);
}
}
- if (grows) {
+ if (grows || hibit) {
sv_setpvn(sv, (char*)dstart, d - dstart);
Safefree(dstart);
+ if (grows && hibit)
+ Safefree(start);
}
else {
*d = '\0';
SvCUR_set(sv, d - dstart);
}
SvUTF8_on(sv);
- if (hibit)
- Safefree(start);
if (!isutf8 && !(PL_hints & HINT_UTF8))
sv_utf8_downgrade(sv, TRUE);
SvSETMAGIC(sv);
OP *
Perl_do_kv(pTHX)
{
- djSP;
+ dSP;
HV *hv = (HV*)POPs;
HV *keys;
register HE *entry;
dokeys = dovalues = TRUE;
if (!hv) {
- if (PL_op->op_flags & OPf_MOD) { /* lvalue */
+ if (PL_op->op_flags & OPf_MOD || LVRET) { /* lvalue */
dTARGET; /* make sure to clear its target here */
if (SvTYPE(TARG) == SVt_PVLV)
LvTARG(TARG) = Nullsv;
IV i;
dTARGET;
- if (PL_op->op_flags & OPf_MOD) { /* lvalue */
+ if (PL_op->op_flags & OPf_MOD || LVRET) { /* lvalue */
if (SvTYPE(TARG) < SVt_PVLV) {
sv_upgrade(TARG, SVt_PVLV);
sv_magic(TARG, Nullsv, 'k', Nullch, 0);