PATCH: [perl #38193] embedded perl always calls setlocale(LC_ALL,"")

This commit causes the locale initialization to skip calling
setlocal(foo, "") if the environment variable PERL_SKIP_LOCALE_INIT is
set.  Instead, the setup code calls setlocale(LC_ALL, NULL) (plus other
similar calls for the subcategories) in order to find out what the
current locale is.

The original poster for this ticket has a workaround for it which
involves using a modified copy of Perl core code.  This patch defines
the C preprocessor variable HAS_SKIP_LOCALE_INIT that can be used by XS
writers to discover if the current Perl version needs the workaround or
not.

I was unable to come up with a test for this patch that did not involve
building extensive infrastructure for testing embedded Perl.  That does
not seem worth it for such a trivial patch.  I tested by hand.

locale.c

@@ -276,6 +276,10 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
 #ifdef __GLIBC__
     char * const language   = PerlEnv_getenv("LANGUAGE");
 #endif
+    /* NULL uses the existing already set up locale */
+    const char * const setlocale_init = (PerlEnv_getenv("PERL_SKIP_LOCALE_INIT"))
+                                        ? NULL
+                                        : "";
     char * const lc_all     = PerlEnv_getenv("LC_ALL");
     char * const lang       = PerlEnv_getenv("LANG");
     bool setlocale_failure = FALSE;
@@ -291,7 +295,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
 
 #   ifdef LC_ALL
     if (lang) {
-	if (setlocale(LC_ALL, ""))
+	if (setlocale(LC_ALL, setlocale_init))
 	    done = TRUE;
 	else
 	    setlocale_failure = TRUE;
@@ -302,7 +306,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
 	if (! (curctype =
 	       setlocale(LC_CTYPE,
 			 (!done && (lang || PerlEnv_getenv("LC_CTYPE")))
-				    ? "" : NULL)))
+				    ? setlocale_init : NULL)))
 	    setlocale_failure = TRUE;
 	else
 	    curctype = savepv(curctype);
@@ -312,7 +316,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
 	if (! (curcoll =
 	       setlocale(LC_COLLATE,
 			 (!done && (lang || PerlEnv_getenv("LC_COLLATE")))
-				   ? "" : NULL)))
+				   ? setlocale_init : NULL)))
 	    setlocale_failure = TRUE;
 	else
 	    curcoll = savepv(curcoll);
@@ -322,7 +326,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
 	if (! (curnum =
 	       setlocale(LC_NUMERIC,
 			 (!done && (lang || PerlEnv_getenv("LC_NUMERIC")))
-				  ? "" : NULL)))
+				  ? setlocale_init : NULL)))
 	    setlocale_failure = TRUE;
 	else
 	    curnum = savepv(curnum);
@@ -334,28 +338,28 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
 #endif /* !LOCALE_ENVIRON_REQUIRED */
 
 #ifdef LC_ALL
-    if (! setlocale(LC_ALL, ""))
+    if (! setlocale(LC_ALL, setlocale_init))
 	setlocale_failure = TRUE;
 #endif /* LC_ALL */
 
     if (!setlocale_failure) {
 #ifdef USE_LOCALE_CTYPE
 	Safefree(curctype);
-	if (! (curctype = setlocale(LC_CTYPE, "")))
+	if (! (curctype = setlocale(LC_CTYPE, setlocale_init)))
 	    setlocale_failure = TRUE;
 	else
 	    curctype = savepv(curctype);
 #endif /* USE_LOCALE_CTYPE */
 #ifdef USE_LOCALE_COLLATE
 	Safefree(curcoll);
-	if (! (curcoll = setlocale(LC_COLLATE, "")))
+	if (! (curcoll = setlocale(LC_COLLATE, setlocale_init)))
 	    setlocale_failure = TRUE;
 	else
 	    curcoll = savepv(curcoll);
 #endif /* USE_LOCALE_COLLATE */
 #ifdef USE_LOCALE_NUMERIC
 	Safefree(curnum);
-	if (! (curnum = setlocale(LC_NUMERIC, "")))
+	if (! (curnum = setlocale(LC_NUMERIC, setlocale_init)))
 	    setlocale_failure = TRUE;
 	else
 	    curnum = savepv(curnum);

perl.h

@@ -691,6 +691,8 @@ struct op *Perl_op asm(stringify(OP_IN_REGISTER));
 
 #if !defined(NO_LOCALE) && defined(HAS_SETLOCALE)
 #   define USE_LOCALE
+#   define HAS_SKIP_LOCALE_INIT /* Solely for XS code to test for this
+                                   capability */
 #   if !defined(NO_LOCALE_COLLATE) && defined(LC_COLLATE) \
        && defined(HAS_STRXFRM)
 #	define USE_LOCALE_COLLATE

pod/perlembed.pod

@@ -1069,6 +1069,25 @@ B<ExtUtils::Embed> can also automate writing the I<xs_init> glue code.
 
 Consult L<perlxs>, L<perlguts>, and L<perlapi> for more details.
 
+=head2 Using embedded Perl with POSIX locales
+
+(See L<perllocale> for information about these.)
+When a Perl interpreter normally starts up, it tells the system it wants
+to use the system's default locale.  This is often, but not necessarily,
+the "C" or "POSIX" locale.  Absent a S<C<"use locale">> within the perl
+code, this mostly has no effect (but see L<perllocale/Not within the
+scope of any use locale variant>).  Also, there is not a problem if the
+locale you want to use in your embedded Perl is the same as the system
+default.  However, this doesn't work if you have set up and want to use
+a locale that isn't the system default one.  Starting in Perl v5.20, you
+can tell the embedded Perl interpreter that the locale is already
+properly set up, and to skip doing its own normal initialization.  It
+skips if the environment variable C<PERL_SKIP_LOCALE_INIT> is set (even
+if set to 0 or C<"">).  A Perl that has this capability will define the
+C pre-processor symbol C<HAS_SKIP_LOCALE_INIT>.  This allows code that
+has to work with multiple Perl versions to do some sort of work-around
+when confronted with an earlier Perl.
+
 =head1 Hiding Perl_
 
 If you completely hide the short forms of the Perl public API,

pod/perllocale.pod

@@ -1368,6 +1368,9 @@ L<POSIX/isupper>, L<POSIX/isxdigit>, L<POSIX/localeconv>,
 L<POSIX/setlocale>, L<POSIX/strcoll>, L<POSIX/strftime>,
 L<POSIX/strtod>, L<POSIX/strxfrm>.
 
+For special considerations when Perl is embedded in a C program,
+see L<perlembed/Using embedded Perl with POSIX locales>.
+
 =head1 HISTORY
 
 Jarkko Hietaniemi's original F<perli18n.pod> heavily hacked by Dominic