#define PERL_IN_DOOP_C
#include "perl.h"
+#ifndef PERL_MICRO
#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
#include <signal.h>
#endif
+#endif
STATIC I32
S_do_trans_CC_simple(pTHX_ SV *sv)
}
STATIC I32
-S_do_trans_UC_simple(pTHX_ SV *sv)
-{
- dTHR;
- U8 *s;
- U8 *send;
- U8 *d;
- I32 matches = 0;
- STRLEN len;
-
- SV* rv = (SV*)cSVOP->op_sv;
- HV* hv = (HV*)SvRV(rv);
- SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
- UV none = svp ? SvUV(*svp) : 0x7fffffff;
- UV extra = none + 1;
- UV final;
- UV uv;
-
- s = (U8*)SvPV(sv, len);
- send = s + len;
-
- svp = hv_fetch(hv, "FINAL", 5, FALSE);
- if (svp)
- final = SvUV(*svp);
-
- d = s;
- while (s < send) {
- if ((uv = swash_fetch(rv, s)) < none) {
- s += UTF8SKIP(s);
- matches++;
- *d++ = (U8)uv;
- }
- else if (uv == none) {
- I32 ulen;
- uv = utf8_to_uv(s, &ulen);
- s += ulen;
- *d++ = (U8)uv;
- }
- else if (uv == extra) {
- s += UTF8SKIP(s);
- matches++;
- *d++ = (U8)final;
- }
- else
- s += UTF8SKIP(s);
- }
- *d = '\0';
- SvCUR_set(sv, d - (U8*)SvPVX(sv));
- SvSETMAGIC(sv);
-
- return matches;
-}
-
-STATIC I32
-S_do_trans_CU_simple(pTHX_ SV *sv)
-{
- dTHR;
- U8 *s;
- U8 *send;
- U8 *d;
- U8 *dst;
- I32 matches = 0;
- STRLEN len;
-
- SV* rv = (SV*)cSVOP->op_sv;
- HV* hv = (HV*)SvRV(rv);
- SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
- UV none = svp ? SvUV(*svp) : 0x7fffffff;
- UV extra = none + 1;
- UV final;
- UV uv;
- U8 tmpbuf[10];
- I32 bits = 16;
-
- s = (U8*)SvPV(sv, len);
- send = s + len;
-
- svp = hv_fetch(hv, "BITS", 4, FALSE);
- if (svp)
- bits = (I32)SvIV(*svp);
-
- svp = hv_fetch(hv, "FINAL", 5, FALSE);
- if (svp)
- final = SvUV(*svp);
-
- Newz(801, d, len * (bits >> 3) + 1, U8);
- dst = d;
-
- while (s < send) {
- uv = *s++;
- if (uv < 0x80)
- tmpbuf[0] = uv;
- else {
- tmpbuf[0] = (( uv >> 6) | 0xc0);
- tmpbuf[1] = (( uv & 0x3f) | 0x80);
- }
-
- if ((uv = swash_fetch(rv, tmpbuf)) < none) {
- matches++;
- d = uv_to_utf8(d, uv);
- }
- else if (uv == none)
- d = uv_to_utf8(d, s[-1]);
- else if (uv == extra) {
- matches++;
- d = uv_to_utf8(d, final);
- }
- }
- *d = '\0';
- sv_usepvn_mg(sv, (char*)dst, d - dst);
-
- return matches;
-}
-
-/* utf-8 to latin-1 */
-
-STATIC I32
-S_do_trans_UC_trivial(pTHX_ SV *sv)
-{
- dTHR;
- U8 *s;
- U8 *send;
- U8 *d;
- STRLEN len;
-
- s = (U8*)SvPV(sv, len);
- send = s + len;
-
- d = s;
- while (s < send) {
- if (*s < 0x80)
- *d++ = *s++;
- else {
- I32 ulen;
- UV uv = utf8_to_uv(s, &ulen);
- s += ulen;
- *d++ = (U8)uv;
- }
- }
- *d = '\0';
- SvCUR_set(sv, d - (U8*)SvPVX(sv));
- SvSETMAGIC(sv);
-
- return SvCUR(sv);
-}
-
-/* latin-1 to utf-8 */
-
-STATIC I32
-S_do_trans_CU_trivial(pTHX_ SV *sv)
-{
- dTHR;
- U8 *s;
- U8 *send;
- U8 *d;
- U8 *dst;
- I32 matches;
- STRLEN len;
-
- s = (U8*)SvPV(sv, len);
- send = s + len;
-
- Newz(801, d, len * 2 + 1, U8);
- dst = d;
-
- matches = send - s;
-
- while (s < send) {
- if (*s < 0x80)
- *d++ = *s++;
- else {
- UV uv = *s++;
- *d++ = (( uv >> 6) | 0xc0);
- *d++ = (( uv & 0x3f) | 0x80);
- }
- }
- *d = '\0';
- sv_usepvn_mg(sv, (char*)dst, d - dst);
-
- return matches;
-}
-
-STATIC I32
S_do_trans_UU_complex(pTHX_ SV *sv)
{
dTHR;
return 0;
if (!SvPOKp(sv))
(void)SvPV_force(sv, len);
- (void)SvPOK_only(sv);
+ if (!(PL_op->op_private & OPpTRANS_IDENTICAL))
+ (void)SvPOK_only_UTF8(sv);
DEBUG_t( Perl_deb(aTHX_ "2.TBL\n"));
switch (PL_op->op_private & 63) {
case 0:
- return do_trans_CC_simple(sv);
-
- case OPpTRANS_FROM_UTF:
- return do_trans_UC_simple(sv);
-
- case OPpTRANS_TO_UTF:
- return do_trans_CU_simple(sv);
-
- case OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF:
- return do_trans_UU_simple(sv);
+ if (SvUTF8(sv))
+ return do_trans_UU_simple(sv);
+ else
+ return do_trans_CC_simple(sv);
case OPpTRANS_IDENTICAL:
- return do_trans_CC_count(sv);
-
- case OPpTRANS_FROM_UTF|OPpTRANS_IDENTICAL:
- return do_trans_UC_trivial(sv);
-
- case OPpTRANS_TO_UTF|OPpTRANS_IDENTICAL:
- return do_trans_CU_trivial(sv);
-
- case OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF|OPpTRANS_IDENTICAL:
- return do_trans_UU_count(sv);
+ if (SvUTF8(sv))
+ return do_trans_UU_count(sv);
+ else
+ return do_trans_CC_count(sv);
default:
- if (PL_op->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF))
+ if (SvUTF8(sv))
return do_trans_UU_complex(sv); /* could be UC or CU too */
else
return do_trans_CC_complex(sv);
if (items-- > 0) {
char *s;
- if (*mark) {
- s = SvPV(*mark, tmplen);
- sv_setpvn(sv, s, tmplen);
- }
- else
- sv_setpv(sv, "");
+ sv_setpv(sv, "");
+ if (*mark)
+ sv_catsv(sv, *mark);
mark++;
}
else
SvTAINTED_on(sv);
}
+/* XXX SvUTF8 support missing! */
UV
Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
{
return retnum;
}
+/* XXX SvUTF8 support missing! */
void
Perl_do_vecset(pTHX_ SV *sv)
{
if (!targ)
return;
s = (unsigned char*)SvPV_force(targ, targlen);
+ (void)SvPOK_only(targ);
lval = SvUV(sv);
offset = LvTARGOFF(sv);
size = LvTARGLEN(sv);
len = (offset + size + 7) / 8; /* required number of bytes */
if (len > targlen) {
s = (unsigned char*)SvGROW(targ, len + 1);
- (void)memzero(s + targlen, len - targlen + 1);
+ (void)memzero((char *)(s + targlen), len - targlen + 1);
SvCUR_set(targ, len);
}
HE* entry;
(void)hv_iterinit(hv);
/*SUPPRESS 560*/
- while (entry = hv_iternext(hv))
+ while ((entry = hv_iternext(hv)))
do_chop(astr,hv_iterval(hv,entry));
return;
}
sv_setpvn(astr, s, 1);
*s = '\0';
SvCUR_set(sv, len);
+ SvUTF8_off(sv);
SvNIOK_off(sv);
}
else
HE* entry;
(void)hv_iterinit(hv);
/*SUPPRESS 560*/
- while (entry = hv_iternext(hv))
+ while ((entry = hv_iternext(hv)))
count += do_chomp(hv_iterval(hv,entry));
return count;
}
I32 lensave;
char *lsave;
char *rsave;
+ bool left_utf = DO_UTF8(left);
+ bool right_utf = DO_UTF8(right);
+
+ if (left_utf && !right_utf)
+ sv_utf8_upgrade(right);
+ if (!left_utf && right_utf)
+ sv_utf8_upgrade(left);
if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
sv_setpvn(sv, "", 0); /* avoid undef warning on |= and ^= */
}
SvCUR_set(sv, len);
(void)SvPOK_only(sv);
+ if (left_utf || right_utf) {
+ UV duc, luc, ruc;
+ STRLEN lulen = leftlen;
+ STRLEN rulen = rightlen;
+ STRLEN dulen = 0;
+ I32 ulen;
+
+ if (optype != OP_BIT_AND)
+ dc = SvGROW(sv, leftlen+rightlen+1);
+
+ switch (optype) {
+ case OP_BIT_AND:
+ while (lulen && rulen) {
+ luc = utf8_to_uv((U8*)lc, &ulen);
+ lc += ulen;
+ lulen -= ulen;
+ ruc = utf8_to_uv((U8*)rc, &ulen);
+ rc += ulen;
+ rulen -= ulen;
+ duc = luc & ruc;
+ dc = (char*)uv_to_utf8((U8*)dc, duc);
+ }
+ dulen = dc - SvPVX(sv);
+ SvCUR_set(sv, dulen);
+ break;
+ case OP_BIT_XOR:
+ while (lulen && rulen) {
+ luc = utf8_to_uv((U8*)lc, &ulen);
+ lc += ulen;
+ lulen -= ulen;
+ ruc = utf8_to_uv((U8*)rc, &ulen);
+ rc += ulen;
+ rulen -= ulen;
+ duc = luc ^ ruc;
+ dc = (char*)uv_to_utf8((U8*)dc, duc);
+ }
+ goto mop_up_utf;
+ case OP_BIT_OR:
+ while (lulen && rulen) {
+ luc = utf8_to_uv((U8*)lc, &ulen);
+ lc += ulen;
+ lulen -= ulen;
+ ruc = utf8_to_uv((U8*)rc, &ulen);
+ rc += ulen;
+ rulen -= ulen;
+ duc = luc | ruc;
+ dc = (char*)uv_to_utf8((U8*)dc, duc);
+ }
+ mop_up_utf:
+ dulen = dc - SvPVX(sv);
+ SvCUR_set(sv, dulen);
+ if (rulen)
+ sv_catpvn(sv, rc, rulen);
+ else if (lulen)
+ sv_catpvn(sv, lc, lulen);
+ else
+ *SvEND(sv) = '\0';
+ break;
+ }
+ SvUTF8_on(sv);
+ goto finish;
+ }
+ else
#ifdef LIBERAL
if (len >= sizeof(long)*4 &&
!((long)dc % sizeof(long)) &&
break;
}
}
+finish:
SvTAINT(sv);
}
EXTEND(SP, HvKEYS(keys) * (dokeys + dovalues));
PUTBACK; /* hv_iternext and hv_iterval might clobber stack_sp */
- while (entry = hv_iternext(keys)) {
+ while ((entry = hv_iternext(keys))) {
SPAGAIN;
if (dokeys)
XPUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */
projects / p5sagit/p5-mst-13.2.git / blobdiff