}
void
+Perl__warn_problematic_locale()
+{
+
+#ifdef USE_LOCALE_CTYPE
+
+ dTHX;
+
+ /* Internal-to-core function that outputs the message in PL_warn_locale,
+ * and then NULLS it. Should be called only through the macro
+ * _CHECK_AND_WARN_PROBLEMATIC_LOCALE */
+
+ if (PL_warn_locale) {
+ /*GCC_DIAG_IGNORE(-Wformat-security); Didn't work */
+ Perl_ck_warner(aTHX_ packWARN(WARN_LOCALE),
+ SvPVX(PL_warn_locale),
+ 0 /* dummy to avoid compiler warning */ );
+ /* GCC_DIAG_RESTORE; */
+ SvREFCNT_dec_NN(PL_warn_locale);
+ PL_warn_locale = NULL;
+ }
+
+#endif
+
+}
+
+void
Perl_new_collate(pTHX_ const char *newcoll)
{
#ifdef USE_LOCALE_COLLATE
* otherwise to use the particular category's variable if set; otherwise to
* use the LANG variable. */
- bool override_LC_ALL = 0;
+ bool override_LC_ALL = FALSE;
char * result;
if (locale && strEQ(locale, "")) {
return result;
}
- /* Here the input locale was LC_ALL, and we have set it to what is in the
+ /* Here the input category was LC_ALL, and we have set it to what is in the
* LANG variable or the system default if there is no LANG. But these have
* lower priority than the other LC_foo variables, so override it for each
* one that is set. (If they are set to "", it means to use the same thing
char *curnum = NULL;
#endif /* USE_LOCALE_NUMERIC */
#ifdef __GLIBC__
- char * const language = PerlEnv_getenv("LANGUAGE");
+ const char * const language = savepv(PerlEnv_getenv("LANGUAGE"));
#endif
/* NULL uses the existing already set up locale */
: "";
const char* trial_locales[5]; /* 5 = 1 each for "", LC_ALL, LANG, "", C */
unsigned int trial_locales_count;
- char * const lc_all = PerlEnv_getenv("LC_ALL");
- char * const lang = PerlEnv_getenv("LANG");
+ const char * const lc_all = savepv(PerlEnv_getenv("LC_ALL"));
+ const char * const lang = savepv(PerlEnv_getenv("LANG"));
bool setlocale_failure = FALSE;
unsigned int i;
char *p;
- const bool locwarn = (printwarn > 1 ||
- (printwarn &&
- (!(p = PerlEnv_getenv("PERL_BADLANG")) ||
- grok_atou(p, NULL))));
+
+ /* A later getenv() could zap this, so only use here */
+ const char * const bad_lang_use_once = PerlEnv_getenv("PERL_BADLANG");
+
+ const bool locwarn = (printwarn > 1
+ || (printwarn
+ && (! bad_lang_use_once
+ || (
+ /* disallow with "" or "0" */
+ *bad_lang_use_once
+ && strNE("0", bad_lang_use_once)))));
bool done = FALSE;
#ifdef WIN32
/* In some systems you can find out the system default locale
}
/* Calculate what fallback locales to try. We have avoided this
- * until we have to, becuase failure is quite unlikely. This will
+ * until we have to, because failure is quite unlikely. This will
* usually change the upper bound of the loop we are in.
*
* Since the system's default way of setting the locale has not
Safefree(curnum);
#endif /* USE_LOCALE_NUMERIC */
+#ifdef __GLIBC__
+ Safefree(language);
+#endif
+
+ Safefree(lc_all);
+ Safefree(lang);
+
#else /* !USE_LOCALE */
PERL_UNUSED_ARG(printwarn);
#endif /* USE_LOCALE */