if (PL_op->op_flags & OPf_REF ||
PL_op->op_private & HINT_STRICT_REFS)
DIE(no_usym, "a symbol");
- if (PL_dowarn)
- warn(warn_uninit);
+ if (ckWARN(WARN_UNINITIALIZED))
+ warner(WARN_UNINITIALIZED, warn_uninit);
RETSETUNDEF;
}
sym = SvPV(sv, PL_na);
if (PL_op->op_flags & OPf_REF ||
PL_op->op_private & HINT_STRICT_REFS)
DIE(no_usym, "a SCALAR");
- if (PL_dowarn)
- warn(warn_uninit);
+ if (ckWARN(WARN_UNINITIALIZED))
+ warner(WARN_UNINITIALIZED, warn_uninit);
RETSETUNDEF;
}
sym = SvPV(sv, PL_na);
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
mg = mg_find(sv, 'g');
if (mg && mg->mg_len >= 0) {
- PUSHi(mg->mg_len + PL_curcop->cop_arybase);
+ I32 i = mg->mg_len;
+ if (IN_UTF8)
+ sv_pos_b2u(sv, &i);
+ PUSHi(i + PL_curcop->cop_arybase);
RETURN;
}
}
SV *ssv = POPs;
STRLEN len;
char *ptr = SvPV(ssv,len);
- if (PL_dowarn && len == 0)
- warn("Explicit blessing to '' (assuming package main)");
+ if (ckWARN(WARN_UNSAFE) && len == 0)
+ warner(WARN_UNSAFE,
+ "Explicit blessing to '' (assuming package main)");
stash = gv_stashpvn(ptr, len, TRUE);
}
EXTEND(SP,1);
}
TARG = sv_newmortal();
- PUSHi(do_trans(sv, PL_op));
+ PUSHi(do_trans(sv));
RETURN;
}
hv_undef((HV*)sv);
break;
case SVt_PVCV:
- if (PL_dowarn && cv_const_sv((CV*)sv))
- warn("Constant subroutine %s undefined",
+ if (ckWARN(WARN_UNSAFE) && cv_const_sv((CV*)sv))
+ warner(WARN_UNSAFE, "Constant subroutine %s undefined",
CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
/* FALL THROUGH */
case SVt_PVFM:
PP(pp_length)
{
djSP; dTARGET;
+
+ if (IN_UTF8) {
+ SETi( sv_len_utf8(TOPs) );
+ RETURN;
+ }
+
SETi( sv_len(TOPs) );
RETURN;
}
SV *sv;
I32 len;
STRLEN curlen;
+ STRLEN utfcurlen;
I32 pos;
I32 rem;
I32 fail;
sv = POPs;
PUTBACK;
tmps = SvPV(sv, curlen);
+ if (IN_UTF8) {
+ utfcurlen = sv_len_utf8(sv);
+ if (utfcurlen == curlen)
+ utfcurlen = 0;
+ else
+ curlen = utfcurlen;
+ }
+ else
+ utfcurlen = 0;
+
if (pos >= arybase) {
pos -= arybase;
rem = curlen-pos;
rem -= pos;
}
if (fail < 0) {
- if (PL_dowarn || lvalue || repl)
- warn("substr outside of string");
+ if (ckWARN(WARN_SUBSTR) || lvalue || repl)
+ warner(WARN_SUBSTR, "substr outside of string");
RETPUSHUNDEF;
}
else {
+ if (utfcurlen)
+ sv_pos_u2b(sv, &pos, &rem);
tmps += pos;
sv_setpvn(TARG, tmps, rem);
if (lvalue) { /* it's an lvalue! */
if (!SvGMAGICAL(sv)) {
if (SvROK(sv)) {
SvPV_force(sv,PL_na);
- if (PL_dowarn)
- warn("Attempt to use reference as lvalue in substr");
+ if (ckWARN(WARN_SUBSTR))
+ warner(WARN_SUBSTR,
+ "Attempt to use reference as lvalue in substr");
}
if (SvOK(sv)) /* is it defined ? */
(void)SvPOK_only(sv);
little = POPs;
big = POPs;
tmps = SvPV(big, biglen);
+ if (IN_UTF8 && offset > 0)
+ sv_pos_u2b(big, &offset, 0);
if (offset < 0)
offset = 0;
else if (offset > biglen)
offset = biglen;
if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset,
(unsigned char*)tmps + biglen, little, 0)))
- retval = -1 + arybase;
+ retval = -1;
else
- retval = tmps2 - tmps + arybase;
- PUSHi(retval);
+ retval = tmps2 - tmps;
+ if (IN_UTF8 && retval > 0)
+ sv_pos_b2u(big, &retval);
+ PUSHi(retval + arybase);
RETURN;
}
SV *little;
STRLEN blen;
STRLEN llen;
- SV *offstr;
I32 offset;
I32 retval;
char *tmps;
I32 arybase = PL_curcop->cop_arybase;
if (MAXARG >= 3)
- offstr = POPs;
+ offset = POPi;
little = POPs;
big = POPs;
tmps2 = SvPV(little, llen);
tmps = SvPV(big, blen);
if (MAXARG < 3)
offset = blen;
- else
- offset = SvIV(offstr) - arybase + llen;
+ else {
+ if (IN_UTF8 && offset > 0)
+ sv_pos_u2b(big, &offset, 0);
+ offset = offset - arybase + llen;
+ }
if (offset < 0)
offset = 0;
else if (offset > blen)
offset = blen;
if (!(tmps2 = rninstr(tmps, tmps + offset,
tmps2, tmps2 + llen)))
- retval = -1 + arybase;
+ retval = -1;
else
- retval = tmps2 - tmps + arybase;
- PUSHi(retval);
+ retval = tmps2 - tmps;
+ if (IN_UTF8 && retval > 0)
+ sv_pos_b2u(big, &retval);
+ PUSHi(retval + arybase);
RETURN;
}
{
djSP; dTARGET;
I32 value;
- char *tmps;
+ U8 *tmps = (U8*)POPp;
+ I32 retlen;
-#ifndef I286
- tmps = POPp;
- value = (I32) (*tmps & 255);
-#else
- I32 anum;
- tmps = POPp;
- anum = (I32) *tmps;
- value = (I32) (anum & 255);
-#endif
+ if (IN_UTF8 && (*tmps & 0x80))
+ value = (I32) utf8_to_uv(tmps, &retlen);
+ else
+ value = (I32) (*tmps & 255);
XPUSHi(value);
RETURN;
}
{
djSP; dTARGET;
char *tmps;
+ I32 value = POPi;
(void)SvUPGRADE(TARG,SVt_PV);
+
+ if (IN_UTF8 && value >= 128) {
+ SvGROW(TARG,8);
+ tmps = SvPVX(TARG);
+ tmps = (char*)uv_to_utf8((U8*)tmps, (UV)value);
+ SvCUR_set(TARG, tmps - SvPVX(TARG));
+ *tmps = '\0';
+ (void)SvPOK_only(TARG);
+ XPUSHs(TARG);
+ RETURN;
+ }
+
SvGROW(TARG,2);
SvCUR_set(TARG, 1);
tmps = SvPVX(TARG);
- *tmps++ = POPi;
+ *tmps++ = value;
*tmps = '\0';
(void)SvPOK_only(TARG);
XPUSHs(TARG);
{
djSP;
SV *sv = TOPs;
- register char *s;
+ register U8 *s;
+ STRLEN slen;
+
+ if (IN_UTF8 && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) {
+ I32 ulen;
+ U8 tmpbuf[10];
+ U8 *tend;
+ UV uv = utf8_to_uv(s, &ulen);
+
+ if (PL_op->op_private & OPpLOCALE) {
+ TAINT;
+ SvTAINTED_on(sv);
+ uv = toTITLE_LC_uni(uv);
+ }
+ else
+ uv = toTITLE_utf8(s);
+
+ tend = uv_to_utf8(tmpbuf, uv);
+
+ if (!SvPADTMP(sv) || tend - tmpbuf != ulen) {
+ dTARGET;
+ sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
+ sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
+ SETs(TARG);
+ }
+ else {
+ s = (U8*)SvPV_force(sv, slen);
+ Copy(tmpbuf, s, ulen, U8);
+ }
+ RETURN;
+ }
if (!SvPADTMP(sv)) {
dTARGET;
sv = TARG;
SETs(sv);
}
- s = SvPV_force(sv, PL_na);
+ s = (U8*)SvPV_force(sv, PL_na);
if (*s) {
if (PL_op->op_private & OPpLOCALE) {
TAINT;
{
djSP;
SV *sv = TOPs;
- register char *s;
+ register U8 *s;
+ STRLEN slen;
+
+ if (IN_UTF8 && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) {
+ I32 ulen;
+ U8 tmpbuf[10];
+ U8 *tend;
+ UV uv = utf8_to_uv(s, &ulen);
+
+ if (PL_op->op_private & OPpLOCALE) {
+ TAINT;
+ SvTAINTED_on(sv);
+ uv = toLOWER_LC_uni(uv);
+ }
+ else
+ uv = toLOWER_utf8(s);
+
+ tend = uv_to_utf8(tmpbuf, uv);
+
+ if (!SvPADTMP(sv) || tend - tmpbuf != ulen) {
+ dTARGET;
+ sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
+ sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
+ SETs(TARG);
+ }
+ else {
+ s = (U8*)SvPV_force(sv, slen);
+ Copy(tmpbuf, s, ulen, U8);
+ }
+ RETURN;
+ }
if (!SvPADTMP(sv)) {
dTARGET;
sv = TARG;
SETs(sv);
}
- s = SvPV_force(sv, PL_na);
+ s = (U8*)SvPV_force(sv, PL_na);
if (*s) {
if (PL_op->op_private & OPpLOCALE) {
TAINT;
{
djSP;
SV *sv = TOPs;
- register char *s;
+ register U8 *s;
STRLEN len;
+ if (IN_UTF8) {
+ dTARGET;
+ I32 ulen;
+ register U8 *d;
+ U8 *send;
+
+ s = (U8*)SvPV(sv,len);
+ if (!len) {
+ sv_setpvn(TARG, "", 0);
+ SETs(TARG);
+ RETURN;
+ }
+
+ (void)SvUPGRADE(TARG, SVt_PV);
+ SvGROW(TARG, (len * 2) + 1);
+ (void)SvPOK_only(TARG);
+ d = (U8*)SvPVX(TARG);
+ send = s + len;
+ if (PL_op->op_private & OPpLOCALE) {
+ TAINT;
+ SvTAINTED_on(TARG);
+ while (s < send) {
+ d = uv_to_utf8(d, toUPPER_LC_uni( utf8_to_uv(s, &ulen)));
+ s += ulen;
+ }
+ }
+ else {
+ while (s < send) {
+ d = uv_to_utf8(d, toUPPER_utf8( s ));
+ s += UTF8SKIP(s);
+ }
+ }
+ *d = '\0';
+ SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
+ SETs(TARG);
+ RETURN;
+ }
+
if (!SvPADTMP(sv)) {
dTARGET;
sv_setsv(TARG, sv);
SETs(sv);
}
- s = SvPV_force(sv, len);
+ s = (U8*)SvPV_force(sv, len);
if (len) {
- register char *send = s + len;
+ register U8 *send = s + len;
if (PL_op->op_private & OPpLOCALE) {
TAINT;
{
djSP;
SV *sv = TOPs;
- register char *s;
+ register U8 *s;
STRLEN len;
+ if (IN_UTF8) {
+ dTARGET;
+ I32 ulen;
+ register U8 *d;
+ U8 *send;
+
+ s = (U8*)SvPV(sv,len);
+ if (!len) {
+ sv_setpvn(TARG, "", 0);
+ SETs(TARG);
+ RETURN;
+ }
+
+ (void)SvUPGRADE(TARG, SVt_PV);
+ SvGROW(TARG, (len * 2) + 1);
+ (void)SvPOK_only(TARG);
+ d = (U8*)SvPVX(TARG);
+ send = s + len;
+ if (PL_op->op_private & OPpLOCALE) {
+ TAINT;
+ SvTAINTED_on(TARG);
+ while (s < send) {
+ d = uv_to_utf8(d, toLOWER_LC_uni( utf8_to_uv(s, &ulen)));
+ s += ulen;
+ }
+ }
+ else {
+ while (s < send) {
+ d = uv_to_utf8(d, toLOWER_utf8(s));
+ s += UTF8SKIP(s);
+ }
+ }
+ *d = '\0';
+ SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
+ SETs(TARG);
+ RETURN;
+ }
+
if (!SvPADTMP(sv)) {
dTARGET;
sv_setsv(TARG, sv);
SETs(sv);
}
- s = SvPV_force(sv, len);
+ s = (U8*)SvPV_force(sv, len);
if (len) {
- register char *send = s + len;
+ register U8 *send = s + len;
if (PL_op->op_private & OPpLOCALE) {
TAINT;
SvGROW(TARG, (len * 2) + 1);
d = SvPVX(TARG);
while (len--) {
- if (!isALNUM(*s))
+ if (!(*s & 0x80) && !isALNUM(*s))
*d++ = '\\';
*d++ = *s++;
}
SV *val = NEWSV(46, 0);
if (MARK < SP)
sv_setsv(val, *++MARK);
- else if (PL_dowarn)
- warn("Odd number of elements in hash assignment");
+ else if (ckWARN(WARN_UNSAFE))
+ warner(WARN_UNSAFE, "Odd number of elements in hash assignment");
(void)hv_store_ent(hv,key,val,0);
}
SP = ORIGMARK;
sv_setsv(TARG, (SP > MARK) ? *SP : DEFSV);
up = SvPV_force(TARG, len);
if (len > 1) {
+ if (IN_UTF8) { /* first reverse each character */
+ U8* s = (U8*)SvPVX(TARG);
+ U8* send = (U8*)(s + len);
+ while (s < send) {
+ if (*s < 0x80) {
+ s++;
+ continue;
+ }
+ else {
+ up = (char*)s;
+ s += UTF8SKIP(s);
+ down = (char*)(s - 1);
+ if (s > send || !((*down & 0xc0) == 0x80)) {
+ warn("Malformed UTF-8 character");
+ break;
+ }
+ while (down > up) {
+ tmp = *up;
+ *up++ = *down;
+ *down-- = tmp;
+ }
+ }
+ }
+ up = SvPVX(TARG);
+ }
down = SvPVX(TARG) + len - 1;
while (down > up) {
tmp = *up;
default:
croak("Invalid type in unpack: '%c'", (int)datumtype);
case ',': /* grandfather in commas but with a warning */
- if (commas++ == 0 && PL_dowarn)
- warn("Invalid type in unpack: '%c'", (int)datumtype);
+ if (commas++ == 0 && ckWARN(WARN_UNSAFE))
+ warner(WARN_UNSAFE, "Invalid type in unpack: '%c'", (int)datumtype);
break;
case '%':
if (len == 1 && pat[-1] != '1')
}
}
break;
+ case 'U':
+ if (len > strend - s)
+ len = strend - s;
+ if (checksum) {
+ while (len-- > 0 && s < strend) {
+ auint = utf8_to_uv((U8*)s, &along);
+ s += along;
+ culong += auint;
+ }
+ }
+ else {
+ EXTEND(SP, len);
+ EXTEND_MORTAL(len);
+ while (len-- > 0 && s < strend) {
+ auint = utf8_to_uv((U8*)s, &along);
+ s += along;
+ sv = NEWSV(37, 0);
+ sv_setiv(sv, (IV)auint);
+ PUSHs(sv_2mortal(sv));
+ }
+ }
+ break;
case 's':
along = (strend - s) / SIZE16;
if (len > along)
char hunk[4];
hunk[3] = '\0';
- len = (*s++ - ' ') & 077;
+ len = uudmap[*s++] & 077;
while (len > 0) {
if (s < strend && ISUUCHAR(*s))
a = uudmap[*s++] & 077;
hunk[4] = '\0';
while (len > 2) {
hunk[0] = uuemap[(077 & (*s >> 2))];
- hunk[1] = uuemap[(077 & ((*s << 4) & 060 | (s[1] >> 4) & 017))];
- hunk[2] = uuemap[(077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03))];
+ hunk[1] = uuemap[(077 & (((*s << 4) & 060) | ((s[1] >> 4) & 017)))];
+ hunk[2] = uuemap[(077 & (((s[1] << 2) & 074) | ((s[2] >> 6) & 03)))];
hunk[3] = uuemap[(077 & (s[2] & 077))];
sv_catpvn(sv, hunk, 4);
s += 3;
if (len > 0) {
char r = (len > 1 ? s[1] : '\0');
hunk[0] = uuemap[(077 & (*s >> 2))];
- hunk[1] = uuemap[(077 & ((*s << 4) & 060 | (r >> 4) & 017))];
+ hunk[1] = uuemap[(077 & (((*s << 4) & 060) | ((r >> 4) & 017)))];
hunk[2] = uuemap[(077 & ((r << 2) & 074))];
hunk[3] = uuemap[0];
sv_catpvn(sv, hunk, 4);
default:
croak("Invalid type in pack: '%c'", (int)datumtype);
case ',': /* grandfather in commas but with a warning */
- if (commas++ == 0 && PL_dowarn)
- warn("Invalid type in pack: '%c'", (int)datumtype);
+ if (commas++ == 0 && ckWARN(WARN_UNSAFE))
+ warner(WARN_UNSAFE, "Invalid type in pack: '%c'", (int)datumtype);
break;
case '%':
DIE("%% may only be used in unpack");
sv_catpvn(cat, &achar, sizeof(char));
}
break;
+ case 'U':
+ while (len-- > 0) {
+ fromstr = NEXTFROM;
+ auint = SvUV(fromstr);
+ SvGROW(cat, SvCUR(cat) + 10);
+ SvCUR_set(cat, (char*)uv_to_utf8((U8*)SvEND(cat),auint)
+ - SvPVX(cat));
+ }
+ *SvEND(cat) = '\0';
+ break;
/* Float and double added by gnb@melba.bby.oz.au 22/11/89 */
case 'f':
case 'F':
* of pack() (and all copies of the result) are
* gone.
*/
- if (PL_dowarn && (SvTEMP(fromstr) || SvPADTMP(fromstr)))
- warn("Attempt to pack pointer to temporary value");
+ if (ckWARN(WARN_UNSAFE) && (SvTEMP(fromstr) || SvPADTMP(fromstr)))
+ warner(WARN_UNSAFE,
+ "Attempt to pack pointer to temporary value");
if (SvPOK(fromstr) || SvNIOK(fromstr))
aptr = SvPV(fromstr,PL_na);
else
projects / p5sagit/p5-mst-13.2.git / blobdiff