This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
locale.c: Tighten what is considered a LC variable
authorKarl Williamson <khw@cpan.org>
Sat, 25 Mar 2017 01:01:39 +0000 (19:01 -0600)
committerKarl Williamson <khw@cpan.org>
Mon, 6 Nov 2017 19:55:57 +0000 (12:55 -0700)
Things like LC_CTYPE are locale variables, but not LC_ctype nor
LC__CTYPE.  Prior to this commit all were treated as locale variables.
Many platforms have more locale variables than Perl knows about, e.g.,
LC_PAPER, and the code tries to catch all possibilities.

locale.c
t/run/locale.t

index 02c195c..5db28ad 100644 (file)
--- a/locale.c
+++ b/locale.c
@@ -1689,7 +1689,6 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
     const char * const lang       = savepv(PerlEnv_getenv("LANG"));
     bool setlocale_failure = FALSE;
     unsigned int i;
-    char *p;
 
     /* A later getenv() could zap this, so only use here */
     const char * const bad_lang_use_once = PerlEnv_getenv("PERL_BADLANG");
@@ -1970,13 +1969,24 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
 #if defined(USE_ENVIRON_ARRAY)
                 {
                     char **e;
+
+                    /* Look through the environment for any variables of the
+                     * form qr/ ^ LC_ [A-Z]+ = /x, except LC_ALL which was
+                     * already handled above.  These are assumed to be locale
+                     * settings.  Output them and their values. */
                     for (e = environ; *e; e++) {
+                        const STRLEN prefix_len = sizeof("LC_") - 1;
+                        STRLEN uppers_len;
+
                         if (     strBEGINs(*e, "LC_")
                             && ! strBEGINs(*e, "LC_ALL=")
-                            && (p = strchr(*e, '=')))
+                            && (uppers_len = strspn(*e + prefix_len,
+                                             "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
+                            && ((*e)[prefix_len + uppers_len] == '='))
                         {
                             PerlIO_printf(Perl_error_log, "\t%.*s = \"%s\",\n",
-                                            (int)(p - *e), *e, p + 1);
+                                (int) (prefix_len + uppers_len), *e,
+                                *e + prefix_len + uppers_len + 1);
                         }
                     }
                 }
index db75b44..267279c 100644 (file)
@@ -25,7 +25,7 @@ my @locales = find_locales( [ 'LC_ALL', 'LC_CTYPE', 'LC_NUMERIC' ]);
 skip_all("no locales available") unless @locales;
 
 # reset the locale environment
-delete local @ENV{'LANG', (grep /^LC_/, keys %ENV)};
+delete local @ENV{'LANG', (grep /^LC_[A-Z]+$/, keys %ENV)};
 
 plan tests => &last;