Front page | perl.perl5.porters |
Postings from September 2000
[PATCH] utf8 error handling flexibility
From:
Simon Cozens
Date:
September 14, 2000 04:48
Subject:
[PATCH] utf8 error handling flexibility
Message ID:
20000914122600.A19510@deep-dark-truthful-mirror.perlhacker.org
To enable callers to have better control over errors, I added another argument
to C<utf8_to_uv>: if this is set, we silently set C<retlen> to -1 and return.
This meant changing the prototype and all the current calls to it. (Don't
forget to run embed.pl)
==== //depot/bleadperl/doop.c#2 (text) ====
Index: perl/doop.c
--- perl/doop.c.~1~ Thu Sep 14 12:23:45 2000
+++ perl/doop.c Thu Sep 14 12:23:45 2000
@@ -77,7 +77,7 @@
ulen = 1;
/* Need to check this, otherwise 128..255 won't match */
- c = utf8_to_uv(s, &ulen);
+ c = utf8_to_uv(s, &ulen, 0);
if (c < 0x100 && (ch = tbl[(short)c]) >= 0) {
matches++;
if (ch < 0x80)
@@ -125,7 +125,7 @@
I32 ulen;
ulen = 1;
if (hasutf)
- c = utf8_to_uv(s,&ulen);
+ c = utf8_to_uv(s,&ulen, 0);
else
c = *s;
if (c < 0x100 && tbl[c] >= 0)
@@ -364,7 +364,7 @@
}
else if (uv == none) { /* "none" is unmapped character */
I32 ulen;
- *d++ = (U8)utf8_to_uv(s, &ulen);
+ *d++ = (U8)utf8_to_uv(s, &ulen, 0);
s += ulen;
puv = 0xfeedface;
continue;
@@ -405,7 +405,7 @@
}
else if (uv == none) { /* "none" is unmapped character */
I32 ulen;
- *d++ = (U8)utf8_to_uv(s, &ulen);
+ *d++ = (U8)utf8_to_uv(s, &ulen, 0);
s += ulen;
continue;
}
@@ -969,10 +969,10 @@
switch (optype) {
case OP_BIT_AND:
while (lulen && rulen) {
- luc = utf8_to_uv((U8*)lc, &ulen);
+ luc = utf8_to_uv((U8*)lc, &ulen, 0);
lc += ulen;
lulen -= ulen;
- ruc = utf8_to_uv((U8*)rc, &ulen);
+ ruc = utf8_to_uv((U8*)rc, &ulen, 0);
rc += ulen;
rulen -= ulen;
duc = luc & ruc;
@@ -984,10 +984,10 @@
break;
case OP_BIT_XOR:
while (lulen && rulen) {
- luc = utf8_to_uv((U8*)lc, &ulen);
+ luc = utf8_to_uv((U8*)lc, &ulen, 0);
lc += ulen;
lulen -= ulen;
- ruc = utf8_to_uv((U8*)rc, &ulen);
+ ruc = utf8_to_uv((U8*)rc, &ulen, 0);
rc += ulen;
rulen -= ulen;
duc = luc ^ ruc;
@@ -996,10 +996,10 @@
goto mop_up_utf;
case OP_BIT_OR:
while (lulen && rulen) {
- luc = utf8_to_uv((U8*)lc, &ulen);
+ luc = utf8_to_uv((U8*)lc, &ulen, 0);
lc += ulen;
lulen -= ulen;
- ruc = utf8_to_uv((U8*)rc, &ulen);
+ ruc = utf8_to_uv((U8*)rc, &ulen, 0);
rc += ulen;
rulen -= ulen;
duc = luc | ruc;
==== //depot/bleadperl/embed.pl#2 (xtext) ====
Index: perl/embed.pl
--- perl/embed.pl.~1~ Thu Sep 14 12:23:45 2000
+++ perl/embed.pl Thu Sep 14 12:23:45 2000
@@ -2074,7 +2074,7 @@
Ap |U8* |utf8_hop |U8 *s|I32 off
ApM |U8* |utf8_to_bytes |U8 *s|STRLEN *len
ApM |U8* |bytes_to_utf8 |U8 *s|STRLEN *len
-Ap |UV |utf8_to_uv |U8 *s|I32* retlen
+Ap |UV |utf8_to_uv |U8 *s|I32* retlen|bool checking
Ap |U8* |uv_to_utf8 |U8 *d|UV uv
p |void |vivify_defelem |SV* sv
p |void |vivify_ref |SV* sv|U32 to_what
==== //depot/bleadperl/handy.h#2 (text) ====
Index: perl/handy.h
--- perl/handy.h.~1~ Thu Sep 14 12:23:45 2000
+++ perl/handy.h Thu Sep 14 12:23:45 2000
@@ -448,21 +448,21 @@
#define isPSXSPC_utf8(c) (isSPACE_utf8(c) ||(c) == '\f')
#define isBLANK_utf8(c) isBLANK(c) /* could be wrong */
-#define isALNUM_LC_utf8(p) isALNUM_LC_uni(utf8_to_uv(p, 0))
-#define isIDFIRST_LC_utf8(p) isIDFIRST_LC_uni(utf8_to_uv(p, 0))
-#define isALPHA_LC_utf8(p) isALPHA_LC_uni(utf8_to_uv(p, 0))
-#define isSPACE_LC_utf8(p) isSPACE_LC_uni(utf8_to_uv(p, 0))
-#define isDIGIT_LC_utf8(p) isDIGIT_LC_uni(utf8_to_uv(p, 0))
-#define isUPPER_LC_utf8(p) isUPPER_LC_uni(utf8_to_uv(p, 0))
-#define isLOWER_LC_utf8(p) isLOWER_LC_uni(utf8_to_uv(p, 0))
-#define isALNUMC_LC_utf8(p) isALNUMC_LC_uni(utf8_to_uv(p, 0))
-#define isCNTRL_LC_utf8(p) isCNTRL_LC_uni(utf8_to_uv(p, 0))
-#define isGRAPH_LC_utf8(p) isGRAPH_LC_uni(utf8_to_uv(p, 0))
-#define isPRINT_LC_utf8(p) isPRINT_LC_uni(utf8_to_uv(p, 0))
-#define isPUNCT_LC_utf8(p) isPUNCT_LC_uni(utf8_to_uv(p, 0))
-#define toUPPER_LC_utf8(p) toUPPER_LC_uni(utf8_to_uv(p, 0))
-#define toTITLE_LC_utf8(p) toTITLE_LC_uni(utf8_to_uv(p, 0))
-#define toLOWER_LC_utf8(p) toLOWER_LC_uni(utf8_to_uv(p, 0))
+#define isALNUM_LC_utf8(p) isALNUM_LC_uni(utf8_to_uv(p, 0, 0))
+#define isIDFIRST_LC_utf8(p) isIDFIRST_LC_uni(utf8_to_uv(p, 0, 0))
+#define isALPHA_LC_utf8(p) isALPHA_LC_uni(utf8_to_uv(p, 0, 0))
+#define isSPACE_LC_utf8(p) isSPACE_LC_uni(utf8_to_uv(p, 0, 0))
+#define isDIGIT_LC_utf8(p) isDIGIT_LC_uni(utf8_to_uv(p, 0, 0))
+#define isUPPER_LC_utf8(p) isUPPER_LC_uni(utf8_to_uv(p, 0, 0))
+#define isLOWER_LC_utf8(p) isLOWER_LC_uni(utf8_to_uv(p, 0, 0))
+#define isALNUMC_LC_utf8(p) isALNUMC_LC_uni(utf8_to_uv(p, 0, 0))
+#define isCNTRL_LC_utf8(p) isCNTRL_LC_uni(utf8_to_uv(p, 0, 0))
+#define isGRAPH_LC_utf8(p) isGRAPH_LC_uni(utf8_to_uv(p, 0, 0))
+#define isPRINT_LC_utf8(p) isPRINT_LC_uni(utf8_to_uv(p, 0, 0))
+#define isPUNCT_LC_utf8(p) isPUNCT_LC_uni(utf8_to_uv(p, 0, 0))
+#define toUPPER_LC_utf8(p) toUPPER_LC_uni(utf8_to_uv(p, 0, 0))
+#define toTITLE_LC_utf8(p) toTITLE_LC_uni(utf8_to_uv(p, 0, 0))
+#define toLOWER_LC_utf8(p) toLOWER_LC_uni(utf8_to_uv(p, 0, 0))
#define isPSXSPC_LC_utf8(c) (isSPACE_LC_utf8(c) ||(c) == '\f')
#define isBLANK_LC_utf8(c) isBLANK(c) /* could be wrong */
==== //depot/bleadperl/op.c#2 (text) ====
Index: perl/op.c
--- perl/op.c.~1~ Thu Sep 14 12:23:45 2000
+++ perl/op.c Thu Sep 14 12:23:45 2000
@@ -2656,7 +2656,7 @@
qsort(cp, i, sizeof(U8*), utf8compare);
for (j = 0; j < i; j++) {
U8 *s = cp[j];
- UV val = utf8_to_uv(s, &ulen);
+ UV val = utf8_to_uv(s, &ulen, 0);
s += ulen;
diff = val - nextmin;
if (diff > 0) {
@@ -2669,7 +2669,7 @@
}
}
if (*s == 0xff)
- val = utf8_to_uv(s+1, &ulen);
+ val = utf8_to_uv(s+1, &ulen, 0);
if (val >= nextmin)
nextmin = val + 1;
}
@@ -2696,10 +2696,10 @@
while (t < tend || tfirst <= tlast) {
/* see if we need more "t" chars */
if (tfirst > tlast) {
- tfirst = (I32)utf8_to_uv(t, &ulen);
+ tfirst = (I32)utf8_to_uv(t, &ulen, 0);
t += ulen;
if (t < tend && *t == 0xff) { /* illegal utf8 val indicates range */
- tlast = (I32)utf8_to_uv(++t, &ulen);
+ tlast = (I32)utf8_to_uv(++t, &ulen, 0);
t += ulen;
}
else
@@ -2709,10 +2709,10 @@
/* now see if we need more "r" chars */
if (rfirst > rlast) {
if (r < rend) {
- rfirst = (I32)utf8_to_uv(r, &ulen);
+ rfirst = (I32)utf8_to_uv(r, &ulen, 0);
r += ulen;
if (r < rend && *r == 0xff) { /* illegal utf8 val indicates range */
- rlast = (I32)utf8_to_uv(++r, &ulen);
+ rlast = (I32)utf8_to_uv(++r, &ulen, 0);
r += ulen;
}
else
==== //depot/bleadperl/pp.c#2 (text) ====
Index: perl/pp.c
--- perl/pp.c.~1~ Thu Sep 14 12:23:45 2000
+++ perl/pp.c Thu Sep 14 12:23:45 2000
@@ -2195,7 +2195,7 @@
I32 retlen;
if ((*tmps & 0x80) && DO_UTF8(tmpsv))
- value = utf8_to_uv(tmps, &retlen);
+ value = utf8_to_uv(tmps, &retlen, 0);
else
value = (UV)(*tmps & 255);
XPUSHu(value);
@@ -2262,7 +2262,7 @@
I32 ulen;
U8 tmpbuf[UTF8_MAXLEN];
U8 *tend;
- UV uv = utf8_to_uv(s, &ulen);
+ UV uv = utf8_to_uv(s, &ulen, 0);
if (PL_op->op_private & OPpLOCALE) {
TAINT;
@@ -2321,7 +2321,7 @@
I32 ulen;
U8 tmpbuf[UTF8_MAXLEN];
U8 *tend;
- UV uv = utf8_to_uv(s, &ulen);
+ UV uv = utf8_to_uv(s, &ulen, 0);
if (PL_op->op_private & OPpLOCALE) {
TAINT;
@@ -2398,7 +2398,7 @@
TAINT;
SvTAINTED_on(TARG);
while (s < send) {
- d = uv_to_utf8(d, toUPPER_LC_uni( utf8_to_uv(s, &ulen)));
+ d = uv_to_utf8(d, toUPPER_LC_uni( utf8_to_uv(s, &ulen, 0)));
s += ulen;
}
}
@@ -2472,7 +2472,7 @@
TAINT;
SvTAINTED_on(TARG);
while (s < send) {
- d = uv_to_utf8(d, toLOWER_LC_uni( utf8_to_uv(s, &ulen)));
+ d = uv_to_utf8(d, toLOWER_LC_uni( utf8_to_uv(s, &ulen, 0)));
s += ulen;
}
}
@@ -3614,7 +3614,7 @@
len = strend - s;
if (checksum) {
while (len-- > 0 && s < strend) {
- auint = utf8_to_uv((U8*)s, &along);
+ auint = utf8_to_uv((U8*)s, &along, 0);
s += along;
if (checksum > 32)
cdouble += (NV)auint;
@@ -3626,7 +3626,7 @@
EXTEND(SP, len);
EXTEND_MORTAL(len);
while (len-- > 0 && s < strend) {
- auint = utf8_to_uv((U8*)s, &along);
+ auint = utf8_to_uv((U8*)s, &along, 0);
s += along;
sv = NEWSV(37, 0);
sv_setuv(sv, (UV)auint);
==== //depot/bleadperl/pp_ctl.c#2 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c.~1~ Thu Sep 14 12:23:45 2000
+++ perl/pp_ctl.c Thu Sep 14 12:23:45 2000
@@ -2959,13 +2959,13 @@
U8 *s = (U8*)SvPVX(sv);
U8 *end = (U8*)SvPVX(sv) + SvCUR(sv);
if (s < end) {
- rev = utf8_to_uv(s, &len);
+ rev = utf8_to_uv(s, &len, 0);
s += len;
if (s < end) {
- ver = utf8_to_uv(s, &len);
+ ver = utf8_to_uv(s, &len, 0);
s += len;
if (s < end)
- sver = utf8_to_uv(s, &len);
+ sver = utf8_to_uv(s, &len, 0);
}
}
if (PERL_REVISION < rev
==== //depot/bleadperl/regcomp.c#2 (text) ====
Index: perl/regcomp.c
--- perl/regcomp.c.~1~ Thu Sep 14 12:23:45 2000
+++ perl/regcomp.c Thu Sep 14 12:23:45 2000
@@ -2881,7 +2881,7 @@
default:
normal_default:
if ((*p & 0xc0) == 0xc0 && UTF) {
- ender = utf8_to_uv((U8*)p, &numlen);
+ ender = utf8_to_uv((U8*)p, &numlen, 0);
p += numlen;
}
else
@@ -3635,12 +3635,12 @@
namedclass = OOB_NAMEDCLASS;
if (!range)
rangebegin = PL_regcomp_parse;
- value = utf8_to_uv((U8*)PL_regcomp_parse, &numlen);
+ value = utf8_to_uv((U8*)PL_regcomp_parse, &numlen, 0);
PL_regcomp_parse += numlen;
if (value == '[')
namedclass = regpposixcc(value);
else if (value == '\\') {
- value = (U32)utf8_to_uv((U8*)PL_regcomp_parse, &numlen);
+ value = (U32)utf8_to_uv((U8*)PL_regcomp_parse, &numlen, 0);
PL_regcomp_parse += numlen;
/* Some compilers cannot handle switching on 64-bit integer
* values, therefore value cannot be an UV. Yes, this will
==== //depot/bleadperl/regexec.c#2 (text) ====
Index: perl/regexec.c
--- perl/regexec.c.~1~ Thu Sep 14 12:23:45 2000
+++ perl/regexec.c Thu Sep 14 12:23:45 2000
@@ -914,7 +914,7 @@
PL_reg_flags |= RF_tainted;
/* FALL THROUGH */
case BOUNDUTF8:
- tmp = (I32)(s != startpos) ? utf8_to_uv(reghop((U8*)s, -1), 0) : '\n';
+ tmp = (I32)(s != startpos) ? utf8_to_uv(reghop((U8*)s, -1), 0, 0) : '\n';
tmp = ((OP(c) == BOUNDUTF8 ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
while (s < strend) {
if (tmp == !(OP(c) == BOUNDUTF8 ?
@@ -950,7 +950,7 @@
PL_reg_flags |= RF_tainted;
/* FALL THROUGH */
case NBOUNDUTF8:
- tmp = (I32)(s != startpos) ? utf8_to_uv(reghop((U8*)s, -1), 0) : '\n';
+ tmp = (I32)(s != startpos) ? utf8_to_uv(reghop((U8*)s, -1), 0, 0) : '\n';
tmp = ((OP(c) == NBOUNDUTF8 ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
while (s < strend) {
if (tmp == !(OP(c) == NBOUNDUTF8 ?
@@ -1995,7 +1995,7 @@
while (s < e) {
if (l >= PL_regeol)
sayNO;
- if (utf8_to_uv((U8*)s, 0) != (c1 ?
+ if (utf8_to_uv((U8*)s, 0, 0) != (c1 ?
toLOWER_utf8((U8*)l) :
toLOWER_LC_utf8((U8*)l)))
{
@@ -2133,7 +2133,7 @@
case NBOUNDUTF8:
/* was last char in word? */
ln = (locinput != PL_regbol)
- ? utf8_to_uv(reghop((U8*)locinput, -1), 0) : PL_regprev;
+ ? utf8_to_uv(reghop((U8*)locinput, -1), 0, 0) : PL_regprev;
if (OP(scan) == BOUNDUTF8 || OP(scan) == NBOUNDUTF8) {
ln = isALNUM_uni(ln);
n = swash_fetch(PL_utf8_alnum, (U8*)locinput);
==== //depot/bleadperl/sv.c#2 (text) ====
Index: perl/sv.c
--- perl/sv.c.~1~ Thu Sep 14 12:23:45 2000
+++ perl/sv.c Thu Sep 14 12:23:45 2000
@@ -2455,7 +2455,7 @@
while (c < SvEND(sv)) {
if (*c & 0x80) {
I32 len;
- UV uv = utf8_to_uv((U8*)c, &len);
+ UV uv = utf8_to_uv((U8*)c, &len, 0);
if (uv >= 256) {
if (fail_ok)
return FALSE;
@@ -2479,7 +2479,7 @@
while (src < SvEND(sv)) {
if (*src & 0x80) {
I32 len;
- U8 u = (U8)utf8_to_uv((U8*)src, &len);
+ U8 u = (U8)utf8_to_uv((U8*)src, &len, 0);
*dst++ = u;
src += len;
}
@@ -2526,7 +2526,7 @@
while (c < SvEND(sv)) {
if (*c & 0x80) {
I32 len;
- (void)utf8_to_uv((U8*)c, &len);
+ (void)utf8_to_uv((U8*)c, &len, 0);
if (len == 1) {
/* bad utf8 */
return FALSE;
@@ -6373,7 +6373,7 @@
break;
}
if (utf)
- iv = (IV)utf8_to_uv(vecstr, &ulen);
+ iv = (IV)utf8_to_uv(vecstr, &ulen, 0);
else {
iv = *vecstr;
ulen = 1;
@@ -6455,7 +6455,7 @@
break;
}
if (utf)
- uv = utf8_to_uv(vecstr, &ulen);
+ uv = utf8_to_uv(vecstr, &ulen, 0);
else {
uv = *vecstr;
ulen = 1;
==== //depot/bleadperl/toke.c#2 (text) ====
Index: perl/toke.c
--- perl/toke.c.~1~ Thu Sep 14 12:23:45 2000
+++ perl/toke.c Thu Sep 14 12:23:45 2000
@@ -812,7 +812,7 @@
I32 skip;
UV n;
if (utf)
- n = utf8_to_uv((U8*)start, &skip);
+ n = utf8_to_uv((U8*)start, &skip, 0);
else {
n = *(U8*)start;
skip = 1;
@@ -1323,7 +1323,7 @@
/* (now in tr/// code again) */
if (*s & 0x80 && thisutf) {
- (void)utf8_to_uv((U8*)s, &len);
+ (void)utf8_to_uv((U8*)s, &len, 0);
if (len == 1) {
/* illegal UTF8, make it valid */
char *old_pvx = SvPVX(sv);
==== //depot/bleadperl/utf8.c#2 (text) ====
Index: perl/utf8.c
--- perl/utf8.c.~1~ Thu Sep 14 12:23:45 2000
+++ perl/utf8.c Thu Sep 14 12:23:45 2000
@@ -158,8 +158,25 @@
return 1;
}
+/*
+=for apidoc Am|utf8_to_uv|U8 *s|I32 *retlen|I32 checking
+
+Returns the character value of the first character in the string C<s>
+which is assumed to be in UTF8 encoding; C<retlen> will be set to the
+length, in bytes, of that character, and the pointer C<s> will be
+advanced to the end of the character.
+
+If C<s> does not point to a well-formed UTF8 character, the behaviour
+is dependent on the value of C<checking>: if this is true, it is
+assumed that the caller will raise a warning, and this function will
+set C<retlen> to C<-1> and return. If C<checking> is not true, an optional UTF8
+warning is produced.
+
+=cut
+*/
+
UV
-Perl_utf8_to_uv(pTHX_ U8* s, I32* retlen)
+Perl_utf8_to_uv(pTHX_ U8* s, I32* retlen, bool checking)
{
UV uv = *s;
int len;
@@ -170,6 +187,11 @@
}
if (!(uv & 0x40)) {
dTHR;
+ if (checking && retlen) {
+ *retlen = -1;
+ return 0;
+ }
+
if (ckWARN_d(WARN_UTF8))
Perl_warner(aTHX_ WARN_UTF8, "Malformed UTF-8 character");
if (retlen)
@@ -192,6 +214,11 @@
while (len--) {
if ((*s & 0xc0) != 0x80) {
dTHR;
+ if (checking && retlen) {
+ *retlen = -1;
+ return 0;
+ }
+
if (ckWARN_d(WARN_UTF8))
Perl_warner(aTHX_ WARN_UTF8, "Malformed UTF-8 character");
if (retlen)
@@ -282,7 +309,7 @@
*d++ = *s++;
else {
I32 ulen;
- *d++ = (U8)utf8_to_uv(s, &ulen);
+ *d++ = (U8)utf8_to_uv(s, &ulen, 0);
s += ulen;
}
}
@@ -810,7 +837,7 @@
if (!PL_utf8_toupper)
PL_utf8_toupper = swash_init("utf8", "ToUpper", &PL_sv_undef, 4, 0);
uv = swash_fetch(PL_utf8_toupper, p);
- return uv ? uv : utf8_to_uv(p,0);
+ return uv ? uv : utf8_to_uv(p,0,0);
}
UV
@@ -821,7 +848,7 @@
if (!PL_utf8_totitle)
PL_utf8_totitle = swash_init("utf8", "ToTitle", &PL_sv_undef, 4, 0);
uv = swash_fetch(PL_utf8_totitle, p);
- return uv ? uv : utf8_to_uv(p,0);
+ return uv ? uv : utf8_to_uv(p,0,0);
}
UV
@@ -832,7 +859,7 @@
if (!PL_utf8_tolower)
PL_utf8_tolower = swash_init("utf8", "ToLower", &PL_sv_undef, 4, 0);
uv = swash_fetch(PL_utf8_tolower, p);
- return uv ? uv : utf8_to_uv(p,0);
+ return uv ? uv : utf8_to_uv(p,0,0);
}
/* a "swash" is a swatch hash */
@@ -922,7 +949,7 @@
PUSHMARK(SP);
EXTEND(SP,3);
PUSHs((SV*)sv);
- PUSHs(sv_2mortal(newSViv(utf8_to_uv(ptr, 0) & ~(needents - 1))));
+ PUSHs(sv_2mortal(newSViv(utf8_to_uv(ptr, 0, 0) & ~(needents - 1))));
PUSHs(sv_2mortal(newSViv(needents)));
PUTBACK;
if (call_method("SWASHGET", G_SCALAR))
End of Patch.
-
[PATCH] utf8 error handling flexibility
by Simon Cozens