Upgrade to I18N::LangTags 0.30.

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

diff --git a/utf8.c b/utf8.c
index 30bb7cf..6f201a2 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -1,6 +1,6 @@
 /*    utf8.c
  *
- *    Copyright (C) 2000, 2001, 2002, 2003, by Larry Wall and others
+ *    Copyright (C) 2000, 2001, 2002, 2003, 2004, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -1401,21 +1401,19 @@ Perl_to_utf8_case(pTHX_ U8 *p, U8* ustrp, STRLEN *lenp, SV **swashp, char *norma
     if (!*swashp) /* load on-demand */
          *swashp = swash_init("utf8", normal, &PL_sv_undef, 4, 0);
 
-    if (special) {
+    /* The 0xDF is the only special casing Unicode code point below 0x100. */
+    if (special && (uv1 == 0xDF || uv1 > 0xFF)) {
          /* It might be "special" (sometimes, but not always,
          * a multicharacter mapping) */
         HV *hv;
-        SV *keysv;
-        HE *he;
-        SV *val;
-       
-        if ((hv    = get_hv(special, FALSE)) &&
-            (keysv = sv_2mortal(Perl_newSVpvf(aTHX_ "%04"UVXf, uv1))) &&
-            (he    = hv_fetch_ent(hv, keysv, FALSE, 0)) &&
-            (val   = HeVAL(he))) {
-            char *s;
+        SV **svp;
+
+        if ((hv  = get_hv(special, FALSE)) &&
+            (svp = hv_fetch(hv, (const char*)tmpbuf, UNISKIP(uv1), FALSE)) &&
+            (*svp)) {
+             char *s;
 
-             s = SvPV(val, len);
+             s = SvPV(*svp, len);
              if (len == 1)
                   len = uvuni_to_utf8(ustrp, NATIVE_TO_UNI(*(U8*)s)) - ustrp;
              else {
@@ -1426,7 +1424,7 @@ Perl_to_utf8_case(pTHX_ U8 *p, U8* ustrp, STRLEN *lenp, SV **swashp, char *norma
                   U8 *t = (U8*)s, *tend = t + len, *d;
                
                   d = tmpbuf;
-                  if (SvUTF8(val)) {
+                  if (SvUTF8(*svp)) {
                        STRLEN tlen = 0;
                        
                        while (t < tend) {
@@ -1566,13 +1564,16 @@ Perl_swash_init(pTHX_ char* pkg, char* name, SV *listsv, I32 minbits, I32 none)
     SV* retval;
     SV* tokenbufsv = sv_2mortal(NEWSV(0,0));
     dSP;
-    HV *stash = gv_stashpvn(pkg, strlen(pkg), FALSE);
+    size_t pkg_len = strlen(pkg);
+    size_t name_len = strlen(name);
+    HV *stash = gv_stashpvn(pkg, pkg_len, FALSE);
     SV* errsv_save;
 
     if (!gv_fetchmeth(stash, "SWASHNEW", 8, -1)) {     /* demand load utf8 */
        ENTER;
        errsv_save = newSVsv(ERRSV);
-       Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpv(pkg,0), Nullsv);
+       Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpvn(pkg,pkg_len),
+                        Nullsv);
        if (!SvTRUE(ERRSV))
            sv_setsv(ERRSV, errsv_save);
        SvREFCNT_dec(errsv_save);
@@ -1582,8 +1583,8 @@ Perl_swash_init(pTHX_ char* pkg, char* name, SV *listsv, I32 minbits, I32 none)
     PUSHSTACKi(PERLSI_MAGIC);
     PUSHMARK(SP);
     EXTEND(SP,5);
-    PUSHs(sv_2mortal(newSVpvn(pkg, strlen(pkg))));
-    PUSHs(sv_2mortal(newSVpvn(name, strlen(name))));
+    PUSHs(sv_2mortal(newSVpvn(pkg, pkg_len)));
+    PUSHs(sv_2mortal(newSVpvn(name, name_len)));
     PUSHs(listsv);
     PUSHs(sv_2mortal(newSViv(minbits)));
     PUSHs(sv_2mortal(newSViv(none)));
@@ -1592,7 +1593,7 @@ 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 (IN_PERL_COMPILETIME) {
        /* XXX ought to be handled by lex_start */
        SAVEI32(PL_in_my);
        PL_in_my = 0;
@@ -1608,7 +1609,7 @@ Perl_swash_init(pTHX_ char* pkg, char* name, SV *listsv, I32 minbits, I32 none)
     SvREFCNT_dec(errsv_save);
     LEAVE;
     POPSTACK;
-    if (PL_curcop == &PL_compiling) {
+    if (IN_PERL_COMPILETIME) {
        STRLEN len;
        char* pv = SvPV(tokenbufsv, len);
 
@@ -1725,7 +1726,7 @@ Perl_swash_fetch(pTHX_ SV *sv, U8 *ptr, bool do_utf8)
            POPSTACK;
            FREETMPS;
            LEAVE;
-           if (PL_curcop == &PL_compiling)
+           if (IN_PERL_COMPILETIME)
                PL_curcop->op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
 
            svp = hv_store(hv, (char*)ptr, klen, retval, 0);