UV
Perl_utf8n_to_uvuni(pTHX_ U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
{
- UV uv = *s, ouv;
+ UV uv = *s, ouv = 0;
STRLEN len = 1;
bool dowarn = ckWARN_d(WARN_UTF8);
STRLEN expectlen = 0;
if (PL_op)
Perl_warner(aTHX_ WARN_UTF8,
- "%s in %s", s, PL_op_desc[PL_op->op_type]);
+ "%s in %s", s, OP_DESC(PL_op));
else
Perl_warner(aTHX_ WARN_UTF8, "%s", s);
}
U8 t = UTF8SKIP(s);
if (e - s < t)
- Perl_croak(aTHX_ "panic: utf8_length: s=%p (%02X) e=%p l=%d - unaligned end",s,*s,e,t);
+ Perl_croak(aTHX_ "panic: utf8_length: unaligned end");
s += t;
len++;
}
bool
Perl_is_uni_xdigit(pTHX_ U32 c)
{
- U8 tmpbuf[UTF8_MAXLEN+1];
+ U8 tmpbuf[UTF8_MAXLEN*2+1];
uvchr_to_utf8(tmpbuf, (UV)c);
return is_utf8_xdigit(tmpbuf);
}
U32
-Perl_to_uni_upper(pTHX_ U32 c)
+Perl_to_uni_upper(pTHX_ U32 c, U8* p, STRLEN *lenp)
{
- U8 tmpbuf[UTF8_MAXLEN+1];
+ U8 tmpbuf[UTF8_MAXLEN*2+1];
uvchr_to_utf8(tmpbuf, (UV)c);
- return to_utf8_upper(tmpbuf);
+ return to_utf8_upper(tmpbuf, p, lenp);
}
U32
-Perl_to_uni_title(pTHX_ U32 c)
+Perl_to_uni_title(pTHX_ U32 c, U8* p, STRLEN *lenp)
{
- U8 tmpbuf[UTF8_MAXLEN+1];
+ U8 tmpbuf[UTF8_MAXLEN*2+1];
uvchr_to_utf8(tmpbuf, (UV)c);
- return to_utf8_title(tmpbuf);
+ return to_utf8_title(tmpbuf, p, lenp);
}
U32
-Perl_to_uni_lower(pTHX_ U32 c)
+Perl_to_uni_lower(pTHX_ U32 c, U8* p, STRLEN *lenp)
{
U8 tmpbuf[UTF8_MAXLEN+1];
uvchr_to_utf8(tmpbuf, (UV)c);
- return to_utf8_lower(tmpbuf);
+ return to_utf8_lower(tmpbuf, p, lenp);
}
/* for now these all assume no locale info available for Unicode > 255 */
return is_uni_xdigit(c); /* XXX no locale support yet */
}
-U32
-Perl_to_uni_upper_lc(pTHX_ U32 c)
-{
- return to_uni_upper(c); /* XXX no locale support yet */
-}
-
-U32
-Perl_to_uni_title_lc(pTHX_ U32 c)
-{
- return to_uni_title(c); /* XXX no locale support yet */
-}
-
-U32
-Perl_to_uni_lower_lc(pTHX_ U32 c)
-{
- return to_uni_lower(c); /* XXX no locale support yet */
-}
-
bool
Perl_is_utf8_alnum(pTHX_ U8 *p)
{
}
UV
-Perl_to_utf8_upper(pTHX_ U8 *p)
+Perl_to_utf8_upper(pTHX_ U8 *p, U8* ustrp, STRLEN *lenp)
{
UV uv;
if (!PL_utf8_toupper)
PL_utf8_toupper = swash_init("utf8", "ToUpper", &PL_sv_undef, 4, 0);
uv = swash_fetch(PL_utf8_toupper, p, TRUE);
- return uv ? UNI_TO_NATIVE(uv) : utf8_to_uvchr(p,0);
+ uv = uv ? UNI_TO_NATIVE(uv) : utf8_to_uvchr(p, 0);
+ *lenp = UNISKIP(uv);
+ uvuni_to_utf8(ustrp, uv);
+ return uv;
}
UV
-Perl_to_utf8_title(pTHX_ U8 *p)
+Perl_to_utf8_title(pTHX_ U8 *p, U8* ustrp, STRLEN *lenp)
{
UV uv;
if (!PL_utf8_totitle)
PL_utf8_totitle = swash_init("utf8", "ToTitle", &PL_sv_undef, 4, 0);
uv = swash_fetch(PL_utf8_totitle, p, TRUE);
- return uv ? UNI_TO_NATIVE(uv) : utf8_to_uvchr(p,0);
+ uv = uv ? UNI_TO_NATIVE(uv) : utf8_to_uvchr(p, 0);
+ *lenp = UNISKIP(uv);
+ uvuni_to_utf8(ustrp, uv);
+ return uv;
}
UV
-Perl_to_utf8_lower(pTHX_ U8 *p)
+Perl_to_utf8_lower(pTHX_ U8 *p, U8* ustrp, STRLEN *lenp)
{
UV uv;
if (!PL_utf8_tolower)
PL_utf8_tolower = swash_init("utf8", "ToLower", &PL_sv_undef, 4, 0);
uv = swash_fetch(PL_utf8_tolower, p, TRUE);
- return uv ? UNI_TO_NATIVE(uv) : utf8_to_uvchr(p,0);
+ uv = uv ? UNI_TO_NATIVE(uv) : utf8_to_uvchr(p, 0);
+ *lenp = UNISKIP(uv);
+ uvuni_to_utf8(ustrp, uv);
+ return uv;
}
/* a "swash" is a swatch hash */
return retval;
}
+
+/* This API is wrong for special case conversions since we may need to
+ * return several Unicode characters for a single Unicode character
+ * (see lib/unicore/SpecCase.txt) The SWASHGET in lib/utf8_heavy.pl is
+ * the lower-level routine, and it is similarly broken for returning
+ * multiple values. --jhi */
UV
Perl_swash_fetch(pTHX_ SV *sv, U8 *ptr, bool do_utf8)
{