Perl_set_numeric_radix(pTHX)
{
#ifdef USE_LOCALE_NUMERIC
- dVAR;
# ifdef HAS_LOCALECONV
const struct lconv* const lc = localeconv();
#endif /* USE_LOCALE_NUMERIC */
}
+/* Is the C string input 'name' "C" or "POSIX"? If so, and 'name' is the
+ * return of setlocale(), then this is extremely likely to be the C or POSIX
+ * locale. However, the output of setlocale() is documented to be opaque, but
+ * the odds are extremely small that it would return these two strings for some
+ * other locale. Note that VMS in these two locales includes many non-ASCII
+ * characters as controls and punctuation (below are hex bytes):
+ * cntrl: 00-1F 7F 84-97 9B-9F
+ * punct: 21-2F 3A-40 5B-60 7B-7E A1-A3 A5 A7-AB B0-B3 B5-B7 B9-BD BF-CF D1-DD DF-EF F1-FD
+ * Oddly, none there are listed as alphas, though some represent alphabetics
+ * http://www.nntp.perl.org/group/perl.perl5.porters/2013/02/msg198753.html */
+#define isNAME_C_OR_POSIX(name) ((name) != NULL \
+ && ((*(name) == 'C' && (*(name) + 1) == '\0') \
+ || strEQ((name), "POSIX")))
+
void
Perl_new_numeric(pTHX_ const char *newnum)
{
* POSIX::setlocale() */
char *save_newnum;
- dVAR;
if (! newnum) {
Safefree(PL_numeric_name);
PL_numeric_name = save_newnum;
}
- PL_numeric_standard = ((*save_newnum == 'C' && save_newnum[1] == '\0')
- || strEQ(save_newnum, "POSIX"));
+ PL_numeric_standard = isNAME_C_OR_POSIX(save_newnum);
PL_numeric_local = TRUE;
/* Keep LC_NUMERIC in the C locale. This is for XS modules, so they don't
set_numeric_radix();
+#else
+ PERL_UNUSED_ARG(newnum);
#endif /* USE_LOCALE_NUMERIC */
}
Perl_set_numeric_standard(pTHX)
{
#ifdef USE_LOCALE_NUMERIC
- dVAR;
-
- /* Toggle the LC_NUMERIC locale to C, if not already there. Probably
- * should use the macros like SET_NUMERIC_STANDARD() in perl.h instead of
- * calling this directly. */
-
- if (_NOT_IN_NUMERIC_STANDARD) {
- setlocale(LC_NUMERIC, "C");
- PL_numeric_standard = TRUE;
- PL_numeric_local = FALSE;
- set_numeric_radix();
- }
+ /* Toggle the LC_NUMERIC locale to C. Most code should use the macros like
+ * SET_NUMERIC_STANDARD() in perl.h instead of calling this directly. The
+ * macro avoids calling this routine if toggling isn't necessary according
+ * to our records (which could be wrong if some XS code has changed the
+ * locale behind our back) */
+
+ setlocale(LC_NUMERIC, "C");
+ PL_numeric_standard = TRUE;
+ PL_numeric_local = isNAME_C_OR_POSIX(PL_numeric_name);
+ set_numeric_radix();
DEBUG_L(PerlIO_printf(Perl_debug_log,
"Underlying LC_NUMERIC locale now is C\n"));
Perl_set_numeric_local(pTHX)
{
#ifdef USE_LOCALE_NUMERIC
- dVAR;
-
- /* Toggle the LC_NUMERIC locale to the current underlying default, if not
- * already there. Probably should use the macros like SET_NUMERIC_LOCAL()
- * in perl.h instead of calling this directly. */
-
- if (_NOT_IN_NUMERIC_LOCAL) {
- setlocale(LC_NUMERIC, PL_numeric_name);
- PL_numeric_standard = FALSE;
- PL_numeric_local = TRUE;
- set_numeric_radix();
- }
+ /* Toggle the LC_NUMERIC locale to the current underlying default. Most
+ * code should use the macros like SET_NUMERIC_LOCAL() in perl.h instead of
+ * calling this directly. The macro avoids calling this routine if
+ * toggling isn't necessary according to our records (which could be wrong
+ * if some XS code has changed the locale behind our back) */
+
+ setlocale(LC_NUMERIC, PL_numeric_name);
+ PL_numeric_standard = isNAME_C_OR_POSIX(PL_numeric_name);
+ PL_numeric_local = TRUE;
+ set_numeric_radix();
DEBUG_L(PerlIO_printf(Perl_debug_log,
"Underlying LC_NUMERIC locale now is %s\n",
PL_numeric_name));
* should be called directly only from this file and from
* POSIX::setlocale() */
- dVAR;
-
if (! newcoll) {
if (PL_collation_name) {
++PL_collation_ix;
++PL_collation_ix;
Safefree(PL_collation_name);
PL_collation_name = stdize_locale(savepv(newcoll));
- PL_collation_standard = ((*newcoll == 'C' && newcoll[1] == '\0')
- || strEQ(newcoll, "POSIX"));
+ PL_collation_standard = isNAME_C_OR_POSIX(newcoll);
{
/* 2: at most so many chars ('a', 'b'). */
}
}
+#else
+ PERL_UNUSED_ARG(newcoll);
#endif /* USE_LOCALE_COLLATE */
}
int ok = 1;
#if defined(USE_LOCALE)
- dVAR;
-
#ifdef USE_LOCALE_CTYPE
char *curctype = NULL;
#endif /* USE_LOCALE_CTYPE */
Safefree(curnum);
#endif /* USE_LOCALE_NUMERIC */
+#else /* !USE_LOCALE */
+ PERL_UNUSED_ARG(printwarn);
#endif /* USE_LOCALE */
return ok;
char *
Perl_mem_collxfrm(pTHX_ const char *s, STRLEN len, STRLEN *xlen)
{
- dVAR;
char *xbuf;
STRLEN xAlloc, xin, xout; /* xalloc is a reserved word in VC */
return FALSE; /* XXX maybe should croak */
}
save_input_locale = stdize_locale(savepv(save_input_locale));
- if ((*save_input_locale == 'C' && save_input_locale[1] == '\0')
- || strEQ(save_input_locale, "POSIX"))
- {
+ if (isNAME_C_OR_POSIX(save_input_locale)) {
DEBUG_L(PerlIO_printf(Perl_debug_log,
"Current locale for category %d is %s\n",
category, save_input_locale));
bool
Perl__is_in_locale_category(pTHX_ const bool compiling, const int category)
{
+ dVAR;
/* Internal function which returns if we are in the scope of a pragma that
* enables the locale category 'category'. 'compiling' should indicate if
* this is during the compilation phase (TRUE) or not (FALSE). */
* LC_MESSAGES */
#ifdef USE_LOCALE_MESSAGES
- if (IN_LC(LC_MESSAGES)) {
+ if (! IN_LC(LC_MESSAGES)) {
char * save_locale = setlocale(LC_MESSAGES, NULL);
- if (! ((*save_locale == 'C' && save_locale[1] == '\0')
- || strEQ(save_locale, "POSIX")))
- {
+ if (! isNAME_C_OR_POSIX(save_locale)) {
char *errstr;
/* The next setlocale likely will zap this, so create a copy */
https://perl5.git.perl.org / perl5.git / blobdiff