#define PERL_IN_UTF8_C
#include "perl.h"
+static char unees[] = "Malformed UTF-8 character (unexpected end of string)";
+
/*
=head1 Unicode Support
if (ckWARN(WARN_UTF8)) {
if (UNICODE_IS_SURROGATE(uv) &&
!(flags & UNICODE_ALLOW_SURROGATE))
- Perl_warner(aTHX_ WARN_UTF8, "UTF-16 surrogate 0x%04"UVxf, uv);
+ Perl_warner(aTHX_ packWARN(WARN_UTF8), "UTF-16 surrogate 0x%04"UVxf, uv);
else if (
((uv >= 0xFDD0 && uv <= 0xFDEF &&
!(flags & UNICODE_ALLOW_FDD0))
((uv <= PERL_UNICODE_MAX) ||
!(flags & UNICODE_ALLOW_SUPER))
)
- Perl_warner(aTHX_ WARN_UTF8,
+ Perl_warner(aTHX_ packWARN(WARN_UTF8),
"Unicode character 0x%04"UVxf" is illegal", uv);
}
if (UNI_IS_INVARIANT(uv)) {
char *s = SvPVX(sv);
if (PL_op)
- Perl_warner(aTHX_ WARN_UTF8,
+ Perl_warner(aTHX_ packWARN(WARN_UTF8),
"%s in %s", s, OP_DESC(PL_op));
else
- Perl_warner(aTHX_ WARN_UTF8, "%s", s);
+ Perl_warner(aTHX_ packWARN(WARN_UTF8), "%s", s);
}
}
* the bitops (especially ~) can create illegal UTF-8.
* In other words: in Perl UTF-8 is not just for Unicode. */
- if (e < s)
- Perl_croak(aTHX_ "panic: utf8_length: unexpected end");
+ if (e < s) {
+ if (ckWARN_d(WARN_UTF8)) {
+ if (PL_op)
+ Perl_warner(aTHX_ packWARN(WARN_UTF8),
+ "%s in %s", unees, OP_DESC(PL_op));
+ else
+ Perl_warner(aTHX_ packWARN(WARN_UTF8), unees);
+ }
+ return 0;
+ }
while (s < e) {
U8 t = UTF8SKIP(s);
- if (e - s < t)
- Perl_croak(aTHX_ "panic: utf8_length: unaligned end");
+ if (e - s < t) {
+ if (ckWARN_d(WARN_UTF8)) {
+ if (PL_op)
+ Perl_warner(aTHX_ packWARN(WARN_UTF8),
+ unees, OP_DESC(PL_op));
+ else
+ Perl_warner(aTHX_ packWARN(WARN_UTF8), unees);
+ }
+ return len;
+ }
s += t;
len++;
}
while (a < b) {
U8 c = UTF8SKIP(a);
- if (b - a < c)
- Perl_croak(aTHX_ "panic: utf8_distance: unaligned end");
+ if (b - a < c) {
+ if (ckWARN_d(WARN_UTF8)) {
+ if (PL_op)
+ Perl_warner(aTHX_ packWARN(WARN_UTF8),
+ "%s in %s", unees, OP_DESC(PL_op));
+ else
+ Perl_warner(aTHX_ packWARN(WARN_UTF8), unees);
+ }
+ return off;
+ }
a += c;
off--;
}
while (b < a) {
U8 c = UTF8SKIP(b);
- if (a - b < c)
- Perl_croak(aTHX_ "panic: utf8_distance: unaligned end");
+ if (a - b < c) {
+ if (ckWARN_d(WARN_UTF8)) {
+ if (PL_op)
+ Perl_warner(aTHX_ packWARN(WARN_UTF8),
+ "%s in %s", unees, OP_DESC(PL_op));
+ else
+ Perl_warner(aTHX_ packWARN(WARN_UTF8), unees);
+ }
+ return off;
+ }
b += c;
off++;
}
case '\a':
Perl_sv_catpvf(aTHX_ dsv, "\\a"); ok = TRUE; break;
case '\\':
- Perl_sv_catpvf(aTHX_ dsv, "\\" ); ok = TRUE; break;
+ Perl_sv_catpvf(aTHX_ dsv, "\\\\" ); ok = TRUE; break;
default: break;
}
}