From: Nicholas Clark <nick@ccl4.org>
Date: Thu, 16 Mar 2006 23:11:11 +0000 (+0000)
Subject: Add a new per-interpeter variable PL_utf8cache, which will be used to
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e07ea26af5fdde170ce4e4e0a797a364c6a185e6;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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