Unicode: add ToFold mapping. Not used yet; but basically

[perl5.git] / sv.c

diff --git a/sv.c b/sv.c
index 520734c..2da1291 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3302,32 +3302,9 @@ Perl_sv_utf8_upgrade_flags(pTHX_ register SV *sv, I32 flags)
        sv_force_normal(sv);
     }
 
-    if (PL_encoding) {
-         SV *uni;
-        STRLEN len;
-        char *s;
-        dSP;
-        ENTER;
-        SAVETMPS;
-        PUSHMARK(sp);
-        EXTEND(SP, 3);
-        XPUSHs(PL_encoding);
-        XPUSHs(sv);
-        XPUSHs(&PL_sv_yes);
-        PUTBACK;
-        call_method("decode", G_SCALAR);
-        SPAGAIN;
-        uni = POPs;
-        PUTBACK;
-        s = SvPVutf8(uni, len);
-        if (s != SvPVX(sv)) {
-             SvGROW(sv, len);
-             Move(s, SvPVX(sv), len, char);
-             SvCUR_set(sv, len);
-        }
-        FREETMPS;
-        LEAVE;
-    } else { /* Assume Latin-1/EBCDIC */
+    if (PL_encoding)
+        Perl_sv_recode_to_utf8(aTHX_ sv, PL_encoding);
+    else { /* Assume Latin-1/EBCDIC */
         /* This function could be much more efficient if we
          * had a FLAG in SVs to signal if there are any hibit
          * chars in the PV.  Given that there isn't such a flag
@@ -3350,9 +3327,9 @@ Perl_sv_utf8_upgrade_flags(pTHX_ register SV *sv, I32 flags)
                   Safefree(s); /* No longer using what was there before. */
              SvLEN(sv) = len; /* No longer know the real size. */
         }
+        /* Mark as UTF-8 even if no hibit - saves scanning loop */
+        SvUTF8_on(sv);
     }
-    /* Mark as UTF-8 even if no hibit - saves scanning loop */
-    SvUTF8_on(sv);
     return SvCUR(sv);
 }
 
@@ -10119,6 +10096,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_utf8_toupper    = sv_dup_inc(proto_perl->Iutf8_toupper, param);
     PL_utf8_totitle    = sv_dup_inc(proto_perl->Iutf8_totitle, param);
     PL_utf8_tolower    = sv_dup_inc(proto_perl->Iutf8_tolower, param);
+    PL_utf8_tofold     = sv_dup_inc(proto_perl->Iutf8_tofold, param);
 
     /* swatch cache */
     PL_last_swash_hv   = Nullhv;       /* reinits on demand */
@@ -10382,3 +10360,52 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
 #endif /* USE_ITHREADS */
 
+/*
+=for apidoc sv_recode_to_utf8
+
+The encoding is assumed to be an Encode object, on entry the PV
+of the sv is assumed to be octets in that encoding, and the sv
+will be converted into Unicode (and UTF-8).
+
+If the sv already is UTF-8 (or if it is not POK), or if the encoding
+is not a reference, nothing is done to the sv.  If the encoding is not
+an C<Encode::XS> Encoding object, bad things will happen.
+(See F<lib/encoding.pm> and L<Encode>).
+
+The PV of the sv is returned.
+
+=cut */
+
+char *
+Perl_sv_recode_to_utf8(pTHX_ SV *sv, SV *encoding)
+{
+     if (SvPOK(sv) && !DO_UTF8(sv) && SvROK(encoding)) {
+         SV *uni;
+         STRLEN len;
+         char *s;
+         dSP;
+         ENTER;
+         SAVETMPS;
+         PUSHMARK(sp);
+         EXTEND(SP, 3);
+         XPUSHs(encoding);
+         XPUSHs(sv);
+         XPUSHs(&PL_sv_yes);
+         PUTBACK;
+         call_method("decode", G_SCALAR);
+         SPAGAIN;
+         uni = POPs;
+         PUTBACK;
+         s = SvPVutf8(uni, len);
+         if (s != SvPVX(sv)) {
+              SvGROW(sv, len);
+              Move(s, SvPVX(sv), len, char);
+              SvCUR_set(sv, len);
+         }
+         FREETMPS;
+         LEAVE;
+         SvUTF8_on(sv);
+     }
+     return SvPVX(sv);
+}
+