((uv >= 0xFDD0 && uv <= 0xFDEF &&
!(flags & UNICODE_ALLOW_FDD0))
||
- ((uv & 0xFFFF) == 0xFFFE &&
- !(flags & UNICODE_ALLOW_FFFE))
- ||
- ((uv & 0xFFFF) == 0xFFFF &&
+ ((uv & 0xFFFE) == 0xFFFE && /* Either FFFE or FFFF. */
!(flags & UNICODE_ALLOW_FFFF))) &&
/* UNICODE_ALLOW_SUPER includes
* FFFEs and FFFFs beyond 0x10FFFF. */
#define UTF8_WARN_SHORT 5
#define UTF8_WARN_OVERFLOW 6
#define UTF8_WARN_SURROGATE 7
-#define UTF8_WARN_BOM 8
-#define UTF8_WARN_LONG 9
-#define UTF8_WARN_FFFF 10
+#define UTF8_WARN_LONG 8
+#define UTF8_WARN_FFFF 9 /* Also FFFE. */
if (curlen == 0 &&
!(flags & UTF8_ALLOW_EMPTY)) {
!(flags & UTF8_ALLOW_SURROGATE)) {
warning = UTF8_WARN_SURROGATE;
goto malformed;
- } else if (UNICODE_IS_BYTE_ORDER_MARK(uv) &&
- !(flags & UTF8_ALLOW_BOM)) {
- warning = UTF8_WARN_BOM;
- goto malformed;
} else if ((expectlen > UNISKIP(uv)) &&
!(flags & UTF8_ALLOW_LONG)) {
warning = UTF8_WARN_LONG;
case UTF8_WARN_SURROGATE:
Perl_sv_catpvf(aTHX_ sv, "(UTF-16 surrogate 0x%04"UVxf")", uv);
break;
- case UTF8_WARN_BOM:
- Perl_sv_catpvf(aTHX_ sv, "(byte order mark 0x%04"UVxf")", uv);
- break;
case UTF8_WARN_LONG:
Perl_sv_catpvf(aTHX_ sv, "(%d byte%s, need %d, after start byte 0x%02"UVxf")",
expectlen, expectlen == 1 ? "": "s", UNISKIP(uv), startbyte);
UV
Perl_utf8_to_uvchr(pTHX_ U8 *s, STRLEN *retlen)
{
- return Perl_utf8n_to_uvchr(aTHX_ s, UTF8_MAXLEN, retlen, 0);
+ return Perl_utf8n_to_uvchr(aTHX_ s, UTF8_MAXLEN, retlen,
+ ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
}
/*
Perl_utf8_to_uvuni(pTHX_ U8 *s, STRLEN *retlen)
{
/* Call the low level routine asking for checks */
- return Perl_utf8n_to_uvuni(aTHX_ s, UTF8_MAXLEN, retlen, 0);
+ return Perl_utf8n_to_uvuni(aTHX_ s, UTF8_MAXLEN, retlen,
+ ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
}
/*
Copy(pv, PL_tokenbuf, len+1, char);
PL_curcop->op_private = PL_hints;
}
- if (!SvROK(retval) || SvTYPE(SvRV(retval)) != SVt_PVHV)
+ if (!SvROK(retval) || SvTYPE(SvRV(retval)) != SVt_PVHV) {
+ if (SvPOK(retval))
+ Perl_croak(aTHX_ "Can't find Unicode property definition \"%s\"",
+ SvPV_nolen(retval));
Perl_croak(aTHX_ "SWASHNEW didn't return an HV ref");
+ }
return retval;
}
/* We use utf8n_to_uvuni() as we want an index into
Unicode tables, not a native character number.
*/
- UV code_point = utf8n_to_uvuni(ptr, UTF8_MAXLEN, NULL, 0);
+ UV code_point = utf8n_to_uvuni(ptr, UTF8_MAXLEN, 0,
+ ckWARN(WARN_UTF8) ?
+ 0 : UTF8_ALLOW_ANY);
SV *errsv_save;
ENTER;
SAVETMPS;