return (char *) querylocale(mask, cur_obj);
# else
+
+ /* If this assert fails, adjust the size of curlocales in intrpvar.h */
+ STATIC_ASSERT_STMT(C_ARRAY_LENGTH(PL_curlocales) > LC_ALL_INDEX);
+
# if defined(_NL_LOCALE_NAME) && defined(DEBUGGING)
{
unsigned int i;
Size_t names_len = 0;
char * all_string;
+ bool are_all_categories_the_same_locale = TRUE;
/* If we have a valid LC_ALL value, just return it */
if (PL_curlocales[LC_ALL_INDEX]) {
/* Otherwise, we need to construct a string of name=value pairs.
* We use the glibc syntax, like
* LC_NUMERIC=C;LC_TIME=en_US.UTF-8;...
- * First calculate the needed size. */
+ * First calculate the needed size. Along the way, check if all
+ * the locale names are the same */
for (i = 0; i < LC_ALL_INDEX; i++) {
# ifdef DEBUGGING
+ 1 /* '=' */
+ strlen(PL_curlocales[i])
+ 1; /* ';' */
+
+ if (i > 0 && strNE(PL_curlocales[i], PL_curlocales[i-1])) {
+ are_all_categories_the_same_locale = FALSE;
+ }
+ }
+
+ /* If they are the same, we don't actually have to construct the
+ * string; we just make the entry in LC_ALL_INDEX valid, and be
+ * that single name */
+ if (are_all_categories_the_same_locale) {
+ PL_curlocales[LC_ALL_INDEX] = savepv(PL_curlocales[0]);
+ return PL_curlocales[LC_ALL_INDEX];
}
+
names_len++; /* Trailing '\0' */
SAVEFREEPV(Newx(all_string, names_len, char));
*all_string = '\0';
/* Keep LC_NUMERIC in the C locale. This is for XS modules, so they don't
* have to worry about the radix being a non-dot. (Core operations that
* need the underlying locale change to it temporarily). */
- set_numeric_standard();
+ if (PL_numeric_standard) {
+ set_numeric_radix(0);
+ }
+ else {
+ set_numeric_standard();
+ }
#endif /* USE_LOCALE_NUMERIC */
* POSIX::setlocale() */
dVAR;
- UV i;
+ unsigned int i;
/* Don't check for problems if we are suppressing the warnings */
bool check_for_problems = ckWARN_d(WARN_LOCALE) || UNLIKELY(DEBUG_L_TEST);
#endif
- retval = do_setlocale_r(category, locale);
+ retval = save_to_buffer(do_setlocale_r(category, locale),
+ &PL_setlocale_buf, &PL_setlocale_bufsize, 0);
SAVE_ERRNO;
#if defined(USE_LOCALE_NUMERIC) && defined(LC_ALL)
return NULL;
}
- save_to_buffer(retval, &PL_setlocale_buf, &PL_setlocale_bufsize, 0);
- retval = PL_setlocale_buf;
-
/* If locale == NULL, we are just querying the state */
if (locale == NULL) {
return retval;
/* Copy the NUL-terminated 'string' to 'buf' + 'offset'. 'buf' has size 'buf_size',
* growing it if necessary */
- const Size_t string_size = strlen(string) + offset + 1;
+ Size_t string_size;
PERL_ARGS_ASSERT_SAVE_TO_BUFFER;
+ if (! string) {
+ return NULL;
+ }
+
+ string_size = strlen(string) + offset + 1;
+
if (*buf_size == 0) {
Newx(*buf, string_size, char);
*buf_size = string_size;
=for apidoc Perl_langinfo
-This is an (almost ª) drop-in replacement for the system C<L<nl_langinfo(3)>>,
+This is an (almost) drop-in replacement for the system C<L<nl_langinfo(3)>>,
taking the same C<item> parameter values, and returning the same information.
But it is more thread-safe than regular C<nl_langinfo()>, and hides the quirks
of Perl's locale handling from your code, and can be used on systems that lack
=item *
+The reason it isn't quite a drop-in replacement is actually an advantage. The
+only difference is that it returns S<C<const char *>>, whereas plain
+C<nl_langinfo()> returns S<C<char *>>, but you are (only by documentation)
+forbidden to write into the buffer. By declaring this C<const>, the compiler
+enforces this restriction, so if it is violated, you know at compilation time,
+rather than getting segfaults at runtime.
+
+=item *
+
It delivers the correct results for the C<RADIXCHAR> and C<THOUSESEP> items,
without you having to write extra code. The reason for the extra code would be
because these are from the C<LC_NUMERIC> locale category, which is normally
kept set to the C locale by Perl, no matter what the underlying locale is
supposed to be, and so to get the expected results, you have to temporarily
-toggle into the underlying locale, and later toggle back. (You could use
-plain C<nl_langinfo> and C<L</STORE_LC_NUMERIC_FORCE_TO_UNDERLYING>> for this
-but then you wouldn't get the other advantages of C<Perl_langinfo()>; not
-keeping C<LC_NUMERIC> in the C locale would break a lot of CPAN, which is
-expecting the radix (decimal point) character to be a dot.)
+toggle into the underlying locale, and later toggle back. (You could use plain
+C<nl_langinfo> and C<L</STORE_LC_NUMERIC_FORCE_TO_UNDERLYING>> for this but
+then you wouldn't get the other advantages of C<Perl_langinfo()>; not keeping
+C<LC_NUMERIC> in the C locale would break a lot of CPAN, which is expecting the
+radix (decimal point) character to be a dot.)
+
+=item *
+
+The system function it replaces can have its static return buffer trashed,
+not only by a subesequent call to that function, but by a C<freelocale>,
+C<setlocale>, or other locale change. The returned buffer of this function is
+not changed until the next call to it, so the buffer is never in a trashed
+state.
+
+=item *
+
+Its return buffer is per-thread, so it also is never overwritten by a call to
+this function from another thread; unlike the function it replaces.
=item *
-Depending on C<item>, it works on systems that don't have C<nl_langinfo>, hence
-makes your code more portable. Of the fifty-some possible items specified by
-the POSIX 2008 standard,
+But most importantly, it works on systems that don't have C<nl_langinfo>, such
+as Windows, hence makes your code more portable. Of the fifty-some possible
+items specified by the POSIX 2008 standard,
L<http://pubs.opengroup.org/onlinepubs/9699919799/basedefs/langinfo.h.html>,
-only two are completely unimplemented. It uses various techniques to recover
-the other items, including calling C<L<localeconv(3)>>, and C<L<strftime(3)>>,
-both of which are specified in C89, so should be always be available. Later
-C<strftime()> versions have additional capabilities; C<""> is returned for
-those not available on your system.
-
-It is important to note that on such systems, this calls C<localeconv>, and so
-overwrites the static buffer returned from previous explicit calls to that
-function. Thus, if the program doesn't use or save the information from an
-explicit C<localeconv> call (which good practice suggests should be done
-anyway), use of this function can break it.
+only two are completely unimplemented (though the loss of one of these is
+significant). It uses various techniques to recover the other items, including
+calling C<L<localeconv(3)>>, and C<L<strftime(3)>>, both of which are specified
+in C89, so should be always be available. Later C<strftime()> versions have
+additional capabilities; C<""> is returned for those not available on your
+system.
+
+It is important to note that when called with an item that is recovered by
+using C<localeconv>, the buffer from any previous explicit call to
+C<localeconv> will be overwritten. This means you must save that buffer's
+contents if you need to access them after a call to this function.
The details for those items which may differ from what this emulation returns
and what a native C<nl_langinfo()> would return are:
=item C<NOSTR>
Only the values for English are returned. C<YESSTR> and C<NOSTR> have been
-removed from POSIX 2008, and are retained for backwards compatibility. Your
-platform's C<nl_langinfo> may not support them.
+removed from POSIX 2008, and are retained here for backwards compatibility.
+Your platform's C<nl_langinfo> may not support them.
=item C<D_FMT>
=back
+=back
+
When using C<Perl_langinfo> on systems that don't have a native
C<nl_langinfo()>, you must
The C<PERL_I<foo>> versions will also work for this function on systems that do
have a native C<nl_langinfo>.
-=item *
-
-It is thread-friendly, returning its result in a buffer that won't be
-overwritten by another thread, so you don't have to code for that possibility.
-The buffer can be overwritten by the next call to C<nl_langinfo> or
-C<Perl_langinfo> in the same thread.
-
-=item *
-
-ª It returns S<C<const char *>>, whereas plain C<nl_langinfo()> returns S<C<char
-*>>, but you are (only by documentation) forbidden to write into the buffer.
-By declaring this C<const>, the compiler enforces this restriction. The extra
-C<const> is why this isn't an unequivocal drop-in replacement for
-C<nl_langinfo>.
-
-=back
-
The original impetus for C<Perl_langinfo()> was so that code that needs to
find out the current currency symbol, floating point radix character, or digit
grouping separator can use, on all systems, the simpler and more
#endif
{
dTHX;
+ const char * retval;
/* We only need to toggle into the underlying LC_NUMERIC locale for these
* two items, and only if not already there */
}
#if defined(HAS_NL_LANGINFO) /* nl_langinfo() is available. */
-#if ! defined(HAS_POSIX_2008_LOCALE)
+# if ! defined(HAS_THREAD_SAFE_NL_LANGINFO_L) \
+ || ! defined(HAS_POSIX_2008_LOCALE)
/* Here, use plain nl_langinfo(), switching to the underlying LC_NUMERIC
* for those items dependent on it. This must be copied to a buffer before
this code section (the only call to nl_langinfo in
the core) */
- save_to_buffer(nl_langinfo(item), &PL_langinfo_buf,
- &PL_langinfo_bufsize, 0);
+
+ /* Copy to a per-thread buffer, which is also one that won't be
+ * destroyed by a subsequent setlocale(), such as the
+ * RESTORE_LC_NUMERIC may do just below. */
+ retval = save_to_buffer(nl_langinfo(item),
+ &PL_langinfo_buf, &PL_langinfo_bufsize, 0);
LOCALE_UNLOCK;
}
}
- save_to_buffer(nl_langinfo_l(item, cur),
- &PL_langinfo_buf, &PL_langinfo_bufsize, 0);
+ /* We have to save it to a buffer, because the freelocale() just below
+ * can invalidate the internal one */
+ retval = save_to_buffer(nl_langinfo_l(item, cur),
+ &PL_langinfo_buf, &PL_langinfo_bufsize, 0);
+
if (do_free) {
freelocale(cur);
}
# endif
- if (strEQ(PL_langinfo_buf, "")) {
+ if (strEQ(retval, "")) {
if (item == PERL_YESSTR) {
return "yes";
}
}
}
- return PL_langinfo_buf;
+ return retval;
#else /* Below, emulate nl_langinfo as best we can */
# ifdef HAS_LOCALECONV
const struct lconv* lc;
+ const char * temp;
DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
# endif
switch (item) {
Size_t len;
- const char * retval;
/* These 2 are unimplemented */
case PERL_CODESET:
}
/* Leave the first spot empty to be filled in below */
- save_to_buffer(lc->currency_symbol, &PL_langinfo_buf,
- &PL_langinfo_bufsize, 1);
+ retval = save_to_buffer(lc->currency_symbol, &PL_langinfo_buf,
+ &PL_langinfo_bufsize, 1);
if (lc->mon_decimal_point && strEQ(lc->mon_decimal_point, ""))
{ /* khw couldn't figure out how the localedef specifications
would show that the $ should replace the radix; this is
just a guess as to how it might work.*/
- *PL_langinfo_buf = '.';
+ PL_langinfo_buf[0] = '.';
}
else if (lc->p_cs_precedes) {
- *PL_langinfo_buf = '-';
+ PL_langinfo_buf[0] = '-';
}
else {
- *PL_langinfo_buf = '+';
+ PL_langinfo_buf[0] = '+';
}
LOCALE_UNLOCK;
lc = localeconv();
if (! lc) {
- retval = "";
+ temp = "";
}
else {
- retval = (item == PERL_RADIXCHAR)
+ temp = (item == PERL_RADIXCHAR)
? lc->decimal_point
: lc->thousands_sep;
- if (! retval) {
- retval = "";
+ if (! temp) {
+ temp = "";
}
}
- save_to_buffer(retval, &PL_langinfo_buf,
- &PL_langinfo_bufsize, 0);
+ retval = save_to_buffer(temp, &PL_langinfo_buf,
+ &PL_langinfo_bufsize, 0);
LOCALE_UNLOCK;
LOCALE_UNLOCK;
+ retval = PL_langinfo_buf;
+
/* If to return the format, not the value, overwrite the buffer
* with it. But some strftime()s will keep the original format
* if illegal, so change those to "" */
*PL_langinfo_buf = '\0';
}
else {
- save_to_buffer(format, &PL_langinfo_buf,
- &PL_langinfo_bufsize, 0);
+ retval = save_to_buffer(format, &PL_langinfo_buf,
+ &PL_langinfo_bufsize, 0);
}
}
}
}
- return PL_langinfo_buf;
+ return retval;
#endif
/*
-=for apidoc sync_locale
+=for apidoc switch_to_global_locale
+
+On systems without locale support, or on single-threaded builds, or on
+platforms that do not support per-thread locale operations, this function does
+nothing. On such systems that do have locale support, only a locale global to
+the whole program is available.
-Changing the program's locale should be avoided by XS code. Nevertheless,
-certain non-Perl libraries called from XS, such as C<Gtk> do so. When this
-happens, Perl needs to be told that the locale has changed. Use this function
-to do so, before returning to Perl.
+On multi-threaded builds on systems that do have per-thread locale operations,
+this function converts the thread it is running in to use the global locale.
+This is for code that has not yet or cannot be updated to handle multi-threaded
+locale operation. As long as only a single thread is so-converted, everything
+works fine, as all the other threads continue to ignore the global one, so only
+this thread looks at it.
+
+Without this function call, threads that use the L<C<setlocale(3)>> system
+function will not work properly, as all the locale-sensitive functions will
+look at the per-thread locale, and C<setlocale> will have no effect on this
+thread.
+
+Perl code should convert to either call
+L<C<Perl_setlocale>|perlapi/Perl_setlocale> (which is a drop-in for the system
+C<setlocale>) or use the methods given in L<perlcall> to call
+L<C<POSIX::setlocale>|POSIX/setlocale>. Either one will transparently properly
+handle all cases of single- vs multi-thread, POSIX 2008-supported or not.
+
+Non-Perl libraries, such as C<gtk>, that call the system C<setlocale> can
+continue to work if this function is called before transferring control to the
+library.
+
+Upon return from the code that needs to use the global locale,
+L<C<sync_locale()>|perlapi/sync_locale> should be called to restore the safe
+multi-thread operation.
=cut
*/
void
-Perl_sync_locale(pTHX)
+Perl_switch_to_global_locale()
+{
+
+#ifdef USE_THREAD_SAFE_LOCALE
+# ifdef WIN32
+
+ _configthreadlocale(_DISABLE_PER_THREAD_LOCALE);
+
+# else
+# ifdef HAS_QUERYLOCALE
+
+ setlocale(LC_ALL, querylocale(LC_ALL_MASK, uselocale((locale_t) 0)));
+
+# else
+
+ {
+ unsigned int i;
+
+ for (i = 0; i < LC_ALL_INDEX; i++) {
+ setlocale(categories[i], do_setlocale_r(categories[i], NULL));
+ }
+ }
+
+# endif
+
+ uselocale(LC_GLOBAL_LOCALE);
+
+# endif
+#endif
+
+}
+
+/*
+
+=for apidoc sync_locale
+
+L<C<Perl_setlocale>|perlapi/Perl_setlocale> can be used at any time to query or
+change the locale (though changing the locale is antisocial and dangerous on
+multi-threaded systems that don't have multi-thread safe locale operations.
+(See L<perllocale/Multi-threaded operation>). Using the system
+L<C<setlocale(3)>> should be avoided. Nevertheless, certain non-Perl libraries
+called from XS, such as C<Gtk> do so, and this can't be changed. When the
+locale is changed by XS code that didn't use
+L<C<Perl_setlocale>|perlapi/Perl_setlocale>, Perl needs to be told that the
+locale has changed. Use this function to do so, before returning to Perl.
+
+The return value is a boolean: TRUE if the global locale at the time of call
+was in effect; and FALSE if a per-thread locale was in effect. This can be
+used by the caller that needs to restore things as-they-were to decide whether
+or not to call
+L<C<Perl_switch_to_global_locale>|perlapi/switch_to_global_locale>.
+
+=cut
+*/
+
+bool
+Perl_sync_locale()
{
const char * newlocale;
+ dTHX;
+
+#ifdef USE_POSIX_2008_LOCALE
+
+ bool was_in_global_locale = FALSE;
+ locale_t cur_obj = uselocale((locale_t) 0);
+
+ /* On Windows, unless the foreign code has turned off the thread-safe
+ * locale setting, any plain setlocale() will have affected what we see, so
+ * no need to worry. Otherwise, If the foreign code has done a plain
+ * setlocale(), it will only affect the global locale on POSIX systems, but
+ * will affect the */
+ if (cur_obj == LC_GLOBAL_LOCALE) {
+
+# ifdef HAS_QUERY_LOCALE
+
+ do_setlocale_c(LC_ALL, setlocale(LC_ALL, NULL));
+
+# else
+
+ unsigned int i;
+
+ /* We can't trust that we can read the LC_ALL format on the
+ * platform, so do them individually */
+ for (i = 0; i < LC_ALL_INDEX; i++) {
+ do_setlocale_r(categories[i], setlocale(categories[i], NULL));
+ }
+
+# endif
+ was_in_global_locale = TRUE;
+ }
+
+#else
+
+ bool was_in_global_locale = TRUE;
+
+#endif
#ifdef USE_LOCALE_CTYPE
newlocale = do_setlocale_c(LC_CTYPE, NULL);
#endif /* USE_LOCALE_NUMERIC */
+ return was_in_global_locale;
}
#if defined(DEBUGGING) && defined(USE_LOCALE)
https://perl5.git.perl.org / perl5.git / blobdiff