locale.c: Cache the current LC_CTYPE locale name

This is now used as a cache of length 1 to avoid having to lookup up the
UTF-8ness as often.

There was a complicated cache previously, but changes to the logic
caused that to be much less necessary, and it is no longer actually
used, and will be removed in a later commit.

But it's pretty easy to keep this single value around to cut further
down the new scheme's need to look it up

This commit also skips doing S_newctype() if the new boss is the same as
the old

embedvar.h

@@ -107,6 +107,7 @@
 #define PL_comppad_name_floor	(vTHX->Icomppad_name_floor)
 #define PL_constpadix		(vTHX->Iconstpadix)
 #define PL_cop_seqmax		(vTHX->Icop_seqmax)
+#define PL_ctype_name		(vTHX->Ictype_name)
 #define PL_curcop		(vTHX->Icurcop)
 #define PL_curcopdb		(vTHX->Icurcopdb)
 #define PL_curlocales		(vTHX->Icurlocales)

intrpvar.h

@@ -806,6 +806,11 @@ PERLVARI(I, numeric_standard, int, TRUE)
 PERLVAR(I, numeric_name, const char *)  /* Name of current numeric locale */
 PERLVAR(I, numeric_radix_sv, SV *)	/* The radix separator if not '.' */
 
+#ifdef USE_LOCALE_CTYPE
+
+PERLVARI(I, ctype_name, const char *, NULL)   /* Name of current ctype locale */
+
+#  endif
 #  ifdef USE_POSIX_2008_LOCALE
 
 PERLVARI(I, underlying_numeric_obj, locale_t, NULL)

locale.c

@@ -1776,15 +1776,35 @@ S_new_ctype(pTHX_ const char *newctype)
 
     PERL_ARGS_ASSERT_NEW_CTYPE;
 
+    /* No change means no-op */
+    if (PL_ctype_name && strEQ(PL_ctype_name, newctype)) {
+        return;
+    }
+
     /* We will replace any bad locale warning with 1) nothing if the new one is
      * ok; or 2) a new warning for the bad new locale */
     if (PL_warn_locale) {
         SvREFCNT_dec_NN(PL_warn_locale);
         PL_warn_locale = NULL;
     }
 
+    /* Clear cache */
+    Safefree(PL_ctype_name);
+    PL_ctype_name = "";
+
+    /* Guard against the is_locale_utf8() call potentially zapping newctype.
+     * This is not extra work as the cache is set to this a few lines down, and
+     * that needs to be saved anyway */
+    newctype = savepv(newctype);
+
+    /* With cache cleared, this will know to compute a new value */
     PL_in_utf8_CTYPE_locale = is_locale_utf8(newctype);
 
+    /* Cache new name */
+    PL_ctype_name = newctype;
+
+    PL_in_utf8_turkic_locale = FALSE;
+
     /* A UTF-8 locale gets standard rules.  But note that code still has to
      * handle this specially because of the three problematic code points */
     if (PL_in_utf8_CTYPE_locale) {
@@ -5809,12 +5829,19 @@ S_is_locale_utf8(pTHX_ const char * locale)
 #  else
 
     const char * scratch_buffer = NULL;
-    const char * codeset = my_langinfo_c(CODESET, LC_CTYPE, locale,
-                                       &scratch_buffer, NULL, NULL);
-    bool retval = is_codeset_name_UTF8(codeset);
+    const char * codeset;
+    bool retval;
 
     PERL_ARGS_ASSERT_IS_LOCALE_UTF8;
 
+    if (PL_ctype_name && strEQ(locale, PL_ctype_name)) {
+        return PL_in_utf8_CTYPE_locale;
+    }
+
+    codeset = my_langinfo_c(CODESET, LC_CTYPE, locale,
+                            &scratch_buffer, NULL, NULL);
+    retval = is_codeset_name_UTF8(codeset);
+
     DEBUG_Lv(PerlIO_printf(Perl_debug_log,
              "%s: %d: found codeset=%s, is_utf8=%d\n",
              __FILE__,  __LINE__, codeset, retval));

makedef.pl

@@ -554,6 +554,12 @@ sub readvar {
 			 );
 }
 
+unless ($define{USE_LOCALE_CTYPE}) {
+    ++$skip{$_} foreach qw(
+		    PL_ctype_name
+			 );
+}
+
 unless ($define{'USE_C_BACKTRACE'}) {
     ++$skip{Perl_get_c_backtrace_dump};
     ++$skip{Perl_dump_c_backtrace};

perl.c

@@ -1152,6 +1152,10 @@ perl_destruct(pTHXx)
     SvREFCNT_dec(PL_numeric_radix_sv);
     PL_numeric_radix_sv = NULL;
 #endif
+#ifdef USE_LOCALE_CTYPE
+    Safefree(PL_ctype_name);
+    PL_ctype_name = NULL;
+#endif
 
     if (PL_setlocale_buf) {
         Safefree(PL_setlocale_buf);

sv.c

@@ -15653,6 +15653,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 #endif
 #ifdef USE_LOCALE_CTYPE
     /* Should we warn if uses locale? */
+    PL_ctype_name	= SAVEPV(proto_perl->Ictype_name);
     PL_warn_locale      = sv_dup_inc(proto_perl->Iwarn_locale, param);
     PL_utf8locale             = proto_perl->Iutf8locale;
     PL_in_utf8_CTYPE_locale   = proto_perl->Iin_utf8_CTYPE_locale;