Add a new per-interpeter variable PL_utf8cache, which will be used to

control the UTF-8 offset caching code. Make this visible as
${^UTF8CACHE}

p4raw-id: //depot/perl@27525

diff --git a/embedvar.h b/embedvar.h
index 64074c4..a688c36 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -444,6 +444,7 @@
 #define PL_utf8_toupper                (vTHX->Iutf8_toupper)
 #define PL_utf8_upper          (vTHX->Iutf8_upper)
 #define PL_utf8_xdigit         (vTHX->Iutf8_xdigit)
+#define PL_utf8cache           (vTHX->Iutf8cache)
 #define PL_utf8locale          (vTHX->Iutf8locale)
 #define PL_uudmap              (vTHX->Iuudmap)
 #define PL_warnhook            (vTHX->Iwarnhook)
@@ -740,6 +741,7 @@
 #define PL_Iutf8_toupper       PL_utf8_toupper
 #define PL_Iutf8_upper         PL_utf8_upper
 #define PL_Iutf8_xdigit                PL_utf8_xdigit
+#define PL_Iutf8cache          PL_utf8cache
 #define PL_Iutf8locale         PL_utf8locale
 #define PL_Iuudmap             PL_uudmap
 #define PL_Iwarnhook           PL_warnhook

diff --git a/gv.c b/gv.c
index 9f64aeb..e2724ee 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1070,6 +1070,8 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                    goto ro_magicalize;
                if (strEQ(name2, "TF8LOCALE"))
                    goto ro_magicalize;
+               if (strEQ(name2, "TF8CACHE"))
+                   goto magicalize;
                break;
            case '\027':        /* $^WARNING_BITS */
                if (strEQ(name2, "ARNING_BITS"))

diff --git a/intrpvar.h b/intrpvar.h
index 3a48de5..aa31aaf 100644 (file)
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -553,6 +553,8 @@ PERLVARI(Imy_cxt_list, void **, NULL) /* per-module array of MY_CXT pointers */
 PERLVAR(Imemory_debug_header, struct perl_memory_debug_header)
 #endif
 
+PERLVARI(Iutf8cache, signed char, 1)   /* Is the utf8 caching code enabled? */
+
 /* New variables must be added to the very end, before this comment,
  * for binary compatibility (the offsets of the old members must not change).
  * (Don't forget to add your variable also to perl_clone()!)

diff --git a/mg.c b/mg.c
index 8cc9d85..d82e9f0 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -790,11 +790,13 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
                    ? (PL_taint_warn || PL_unsafe ? -1 : 1)
                    : 0);
         break;
-    case '\025':               /* $^UNICODE, $^UTF8LOCALE */
+    case '\025':               /* $^UNICODE, $^UTF8LOCALE, $^UTF8CACHE */
        if (strEQ(remaining, "NICODE"))
            sv_setuv(sv, (UV) PL_unicode);
        else if (strEQ(remaining, "TF8LOCALE"))
            sv_setuv(sv, (UV) PL_utf8locale);
+       else if (strEQ(remaining, "TF8CACHE"))
+           sv_setiv(sv, (IV) PL_utf8cache);
         break;
     case '\027':               /* ^W  & $^WARNING_BITS */
        if (nextchar == '\0')
@@ -2232,6 +2234,11 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        PL_basetime = (Time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
 #endif
        break;
+    case '\025':       /* ^UTF8CACHE */
+        if (strEQ(mg->mg_ptr+1, "TF8CACHE")) {
+            PL_utf8cache = (signed char) sv_2iv(sv);
+        }
+        break;
     case '\027':       /* ^W & $^WARNING_BITS */
        if (*(mg->mg_ptr+1) == '\0') {
            if ( ! (PL_dowarn & G_WARN_ALL_MASK)) {

diff --git a/perlapi.h b/perlapi.h
index de8ecb6..91422e3 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -686,6 +686,8 @@ END_EXTERN_C
 #define PL_utf8_upper          (*Perl_Iutf8_upper_ptr(aTHX))
 #undef  PL_utf8_xdigit
 #define PL_utf8_xdigit         (*Perl_Iutf8_xdigit_ptr(aTHX))
+#undef  PL_utf8cache
+#define PL_utf8cache           (*Perl_Iutf8cache_ptr(aTHX))
 #undef  PL_utf8locale
 #define PL_utf8locale          (*Perl_Iutf8locale_ptr(aTHX))
 #undef  PL_uudmap

diff --git a/pod/perlvar.pod b/pod/perlvar.pod
index b63973e..33c68a0 100644 (file)
--- a/pod/perlvar.pod
+++ b/pod/perlvar.pod
@@ -1145,6 +1145,10 @@ documentation for the C<-C> switch for more information about
 the possible values. This variable is set during Perl startup
 and is thereafter read-only.
 
+=item ${^UTF8CACHE}
+
+This variable controls the state of the internal UTF-8 offset caching code.
+
 =item ${^UTF8LOCALE}
 
 This variable indicates whether an UTF-8 locale was detected by perl at