Skip to content

Commit

Permalink
wrap uselocale
Browse files Browse the repository at this point in the history
  • Loading branch information
@khwilliamson
khwilliamson committed Nov 20, 2023
1 parent 9f25f93 commit 03244ff
Showing 1 changed file with 27 additions and 14 deletions.
41 changes: 27 additions & 14 deletions locale.c
View file
Expand Up @@ -424,6 +424,19 @@ static int debug_initialization = 0;
# error Revert the commit that added this line
#endif

#define wrap_uselocale(a) \
({ \
locale_t obj = uselocale(a); \
const char * name; \
if (obj == LC_GLOBAL_LOCALE) name = "global object"; \
else if (obj == PL_cur_locale_obj) name = "current locale object"; \
else if (obj == PL_C_locale_obj) name = "C object"; \
else name = Perl_form(aTHX_ "0x%p", (void *) obj); \
if (a == 0) DEBUG_U(PerlIO_printf(Perl_debug_log, "uselocale(0) returned %s\n", name)); \
else DEBUG_U(PerlIO_printf(Perl_debug_log, "changing locale to 0x%p returned %s\n", (void *) a, name)); \
obj;\
})

#ifdef WIN32_USE_FAKE_OLD_MINGW_LOCALES

/* Use -Accflags=-DWIN32_USE_FAKE_OLD_MINGW_LOCALES on a POSIX or *nix box
Expand Down Expand Up @@ -1064,7 +1077,7 @@ S_use_curlocale_scratch(pTHX)
* creates a proper P2008 object. Any prior object is deleted, as is any
* remaining object during global destruction. */

locale_t cur = uselocale((locale_t) 0);
locale_t cur = wrap_uselocale((locale_t) 0);

if (cur != LC_GLOBAL_LOCALE) {
return cur;
Expand Down Expand Up @@ -2411,7 +2424,7 @@ S_querylocale_2008_i(pTHX_ const locale_category_index index,
* find_locale_from_environment() give details on the potential race.)
*/

const locale_t cur_obj = uselocale((locale_t) 0);
const locale_t cur_obj = wrap_uselocale((locale_t) 0);
const char * retval;

# ifdef MULTIPLICITY
Expand Down Expand Up @@ -2619,7 +2632,7 @@ S_bool_setlocale_2008_i(pTHX_
*/

int mask = category_masks[index];
const locale_t entry_obj = uselocale((locale_t) 0);
const locale_t entry_obj = wrap_uselocale((locale_t) 0);

# ifdef MULTIPLICITY
assert(entry_obj== LC_GLOBAL_LOCALE || entry_obj == PL_cur_locale_obj);
Expand Down Expand Up @@ -2731,7 +2744,7 @@ S_bool_setlocale_2008_i(pTHX_
* the C library's discretion), hence we can't be using that locale at the
* time of the switch (this wasn't obvious to khw from the man pages). So
* switch to a known locale object that we don't otherwise mess with. */
if (! uselocale(PL_C_locale_obj)) {
if (! wrap_uselocale(PL_C_locale_obj)) {

/* Not being able to change to the C locale is severe; don't keep
* going. */
Expand Down Expand Up @@ -2931,7 +2944,7 @@ S_bool_setlocale_2008_i(pTHX_

/* Here, successfully created an object representing the desired locale;
* now switch into it */
if (! uselocale(new_obj)) {
if (! wrap_uselocale(new_obj)) {
freelocale(new_obj);
locale_panic_(Perl_form(aTHX_ "(called from %" LINE_Tf "):"
" bool_setlocale_2008_i: switching"
Expand Down Expand Up @@ -2978,7 +2991,7 @@ S_bool_setlocale_2008_i(pTHX_

/* We earlier switched to the LC_ALL => C locale in anticipation of it
* succeeding, Now have to switch back to the state upon entry. */
if (! uselocale(entry_obj)) {
if (! wrap_uselocale(entry_obj)) {
setlocale_failure_panic_i(index, "switching back to",
locale_on_entry, __LINE__, caller_line);
}
Expand Down Expand Up @@ -7936,7 +7949,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
* anyway, but deferring it can lead to leaks of memory that would also get
* malloc'd in the interim. We arbitrarily switch to the C locale,
* overridden below */
if (! uselocale(PL_C_locale_obj)) {
if (! wrap_uselocale(PL_C_locale_obj)) {
locale_panic_(Perl_form(aTHX_
"Can't uselocale(%p), LC_ALL supposed to"
" be 'C'",
Expand Down Expand Up @@ -8334,7 +8347,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
DEBUG_Lv(PerlIO_printf(Perl_debug_log,
"finished Perl_init_i18nl10n; actual obj=%p,"
" expected obj=%p, initial=%s\n",
uselocale(0), PL_cur_locale_obj,
wrap_uselocale(0), PL_cur_locale_obj,
get_LC_ALL_display()));
# endif

Expand Down Expand Up @@ -9656,7 +9669,7 @@ handle all cases of single- vs multi-thread, POSIX 2008-supported or not.
#elif defined(USE_POSIX_2008_LOCALE)
# define CHANGE_SYSTEM_LOCALE_TO_GLOBAL \
STMT_START { \
locale_t old_locale = uselocale(LC_GLOBAL_LOCALE); \
locale_t old_locale = wrap_uselocale(LC_GLOBAL_LOCALE); \
if (! old_locale) { \
locale_panic_("Could not change to global locale"); \
} \
Expand Down Expand Up @@ -9688,7 +9701,7 @@ Perl_switch_to_global_locale(pTHX)
* global locale or not. */
# ifdef USE_POSIX_2008_LOCALE

const bool perl_controls = (LC_GLOBAL_LOCALE != uselocale((locale_t) 0));
const bool perl_controls = (LC_GLOBAL_LOCALE != wrap_uselocale((locale_t) 0));

# elif defined(USE_THREAD_SAFE_LOCALE) && defined(WIN32)

Expand Down Expand Up @@ -9832,7 +9845,7 @@ Perl_sync_locale(pTHX)

# elif defined(USE_POSIX_2008_LOCALE) /* Thread-safe POSIX 2008 */

was_in_global = (LC_GLOBAL_LOCALE == uselocale(LC_GLOBAL_LOCALE));
was_in_global = (LC_GLOBAL_LOCALE == wrap_uselocale(LC_GLOBAL_LOCALE));

# else
# error Unexpected Configuration
Expand Down Expand Up @@ -9977,7 +9990,7 @@ Perl_switch_locale_context(pTHX)

# ifdef USE_POSIX_2008_LOCALE

if (! uselocale(PL_cur_locale_obj)) {
if (! wrap_uselocale(PL_cur_locale_obj)) {
locale_panic_(Perl_form(aTHX_
"Can't uselocale(%p), LC_ALL supposed to"
" be '%s'",
Expand Down Expand Up @@ -10028,7 +10041,7 @@ Perl_thread_locale_init(pTHX)
" calling setlocale(LC_ALL, \"C\")\n",
get_LC_ALL_display()));

if (! uselocale(PL_C_locale_obj)) {
if (! wrap_uselocale(PL_C_locale_obj)) {

/* Not being able to change to the C locale is severe; don't keep
* going. */
Expand Down Expand Up @@ -10073,7 +10086,7 @@ Perl_thread_locale_term(pTHX)
#if defined(USE_POSIX_2008_LOCALE) && defined(USE_THREADS)

/* Switch to the global locale, so can free up the per-thread object */
locale_t actual_obj = uselocale(LC_GLOBAL_LOCALE);
locale_t actual_obj = wrap_uselocale(LC_GLOBAL_LOCALE);
if (actual_obj != LC_GLOBAL_LOCALE && actual_obj != PL_C_locale_obj) {
freelocale(actual_obj);
}
Expand Down

0 comments on commit 03244ff

Please sign in to comment.