Various tweaks to Encode

[p5sagit/p5-mst-13.2.git] / utf8.c

diff --git a/utf8.c b/utf8.c
index 0100eb1..3ad3a95 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -64,13 +64,10 @@ Perl_uvuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)
                  ((uv >= 0xFDD0 && uv <= 0xFDEF &&
                    !(flags & UNICODE_ALLOW_FDD0))
                   ||
-                  (UNICODE_IS_BYTE_ORDER_MARK(uv) &&
-                   !(flags & UNICODE_ALLOW_BOM))
-                  ||
-                  ((uv & 0xFFFF) == 0xFFFF &&
+                  ((uv & 0xFFFE) == 0xFFFE && /* Either FFFE or FFFF. */
                    !(flags & UNICODE_ALLOW_FFFF))) &&
                  /* UNICODE_ALLOW_SUPER includes
-                  * FFFFs beyond 0x10FFFF. */
+                  * FFFEs and FFFFs beyond 0x10FFFF. */
                  ((uv <= PERL_UNICODE_MAX) ||
                   !(flags & UNICODE_ALLOW_SUPER))
                  )
@@ -173,12 +170,11 @@ Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv)
 =for apidoc A|STRLEN|is_utf8_char|U8 *s
 
 Tests if some arbitrary number of bytes begins in a valid UTF-8
-character.  Note that an INVARIANT (i.e. ASCII) character is a valid UTF-8 character.
-The actual number of bytes in the UTF-8 character will be returned if
-it is valid, otherwise 0.
+character.  Note that an INVARIANT (i.e. ASCII) character is a valid
+UTF-8 character.  The actual number of bytes in the UTF-8 character
+will be returned if it is valid, otherwise 0.
 
-=cut
-*/
+=cut */
 STRLEN
 Perl_is_utf8_char(pTHX_ U8 *s)
 {
@@ -296,9 +292,8 @@ Perl_utf8n_to_uvuni(pTHX_ U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
 #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)) {
@@ -393,10 +388,6 @@ Perl_utf8n_to_uvuni(pTHX_ U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
        !(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;
@@ -452,9 +443,6 @@ malformed:
        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);
@@ -1167,9 +1155,27 @@ Perl_is_utf8_alnumc(pTHX_ U8 *p)
 }
 
 bool
-Perl_is_utf8_idfirst(pTHX_ U8 *p)
+Perl_is_utf8_idfirst(pTHX_ U8 *p) /* The naming is historical. */
+{
+    if (*p == '_')
+       return TRUE;
+    if (!is_utf8_char(p))
+       return FALSE;
+    if (!PL_utf8_idstart) /* is_utf8_idstart would be more logical. */
+       PL_utf8_idstart = swash_init("utf8", "IdStart", &PL_sv_undef, 0, 0);
+    return swash_fetch(PL_utf8_idstart, p, TRUE);
+}
+
+bool
+Perl_is_utf8_idcont(pTHX_ U8 *p)
 {
-    return *p == '_' || is_utf8_alpha(p);
+    if (*p == '_')
+       return TRUE;
+    if (!is_utf8_char(p))
+       return FALSE;
+    if (!PL_utf8_idcont)
+       PL_utf8_idcont = swash_init("utf8", "IdContinue", &PL_sv_undef, 0, 0);
+    return swash_fetch(PL_utf8_idcont, p, TRUE);
 }
 
 bool
@@ -1525,9 +1531,11 @@ Perl_swash_init(pTHX_ char* pkg, char* name, SV *listsv, I32 minbits, I32 none)
     SAVEI32(PL_hints);
     PL_hints = 0;
     save_re_context();
-    if (PL_curcop == &PL_compiling)
+    if (PL_curcop == &PL_compiling) {
        /* XXX ought to be handled by lex_start */
+       SAVEI32(PL_in_my);
        sv_setpv(tokenbufsv, PL_tokenbuf);
+    }
     errsv_save = newSVsv(ERRSV);
     if (call_method("SWASHNEW", G_SCALAR))
        retval = newSVsv(*PL_stack_sp--);