diff --git a/embed.fnc b/embed.fnc index 7727f96bf065..9e65b1713173 100644 --- a/embed.fnc +++ b/embed.fnc @@ -3232,6 +3232,11 @@ iTR |const char *|save_to_buffer|NULLOK const char * string \ S |char* |stdize_locale |NN char* locs S |void |new_collate |NULLOK const char* newcoll S |void |new_ctype |NN const char* newctype +Sr |void |setlocale_failure_panic_i|const unsigned int cat_index \ + |NULLOK const char * current \ + |NN const char * failed \ + |const line_t caller_0_line \ + |const line_t caller_1_line S |void |set_numeric_radix|const bool use_locale S |void |new_numeric |NULLOK const char* newnum # ifdef USE_POSIX_2008_LOCALE diff --git a/embed.h b/embed.h index dcf1db1173d7..dcf678b892a4 100644 --- a/embed.h +++ b/embed.h @@ -1698,6 +1698,7 @@ #define new_numeric(a) S_new_numeric(aTHX_ a) #define restore_switched_locale(a,b) S_restore_switched_locale(aTHX_ a,b) #define set_numeric_radix(a) S_set_numeric_radix(aTHX_ a) +#define setlocale_failure_panic_i(a,b,c,d,e) S_setlocale_failure_panic_i(aTHX_ a,b,c,d,e) #define stdize_locale(a) S_stdize_locale(aTHX_ a) #define switch_category_locale_to_template(a,b,c) S_switch_category_locale_to_template(aTHX_ a,b,c) # if defined(USE_POSIX_2008_LOCALE) diff --git a/locale.c b/locale.c index af911df752b9..00be6c3a272b 100644 --- a/locale.c +++ b/locale.c @@ -370,6 +370,11 @@ S_category_name(const int category) #endif /* ifdef USE_LOCALE */ +#define setlocale_failure_panic_c( \ + cat, current, failed, caller_0_line, caller_1_line) \ + setlocale_failure_panic_i(cat##_INDEX_, current, failed, \ + caller_0_line, caller_1_line) + /* porcelain_setlocale() presents a consistent POSIX-compliant interface to * setlocale(). Windows requres a customized base-level setlocale() */ #ifdef WIN32 @@ -394,9 +399,17 @@ S_category_name(const int category) # define setlocale_i(i, locale) setlocale_c(categories[i], locale) # define setlocale_r(cat, locale) setlocale_c(cat, locale) -# define void_setlocale_c(cat, locale) ((void) setlocale_c(cat, locale)) -# define void_setlocale_i(i, locale) ((void) setlocale_i(i locale)) -# define void_setlocale_r(cat, locale) ((void) setlocale_r(cat, locale)) +# define void_setlocale_i(i, locale) \ + STMT_START { \ + if (! porcelain_setlocale(categories[i], locale)) { \ + setlocale_failure_panic_i(i, NULL, locale, __LINE__, 0); \ + NOT_REACHED; /* NOTREACHED */ \ + } \ + } STMT_END +# define void_setlocale_c(cat, locale) \ + void_setlocale_i(cat##_INDEX_, locale) +# define void_setlocale_r(cat, locale) \ + void_setlocale_i(get_category_index(cat, locale), locale) # define bool_setlocale_c(cat, locale) cBOOL(setlocale_c(cat, locale)) # define bool_setlocale_i(i, locale) cBOOL(setlocale_i(i, locale)) @@ -1145,6 +1158,38 @@ S_stdize_locale(pTHX_ char *locs) return locs; } +STATIC void +S_setlocale_failure_panic_i(pTHX_ + const unsigned int cat_index, + const char * current, + const char * failed, + const line_t caller_0_line, + const line_t caller_1_line) +{ + const int cat = categories[cat_index]; + const char * name = category_names[cat_index]; + dSAVE_ERRNO; + + PERL_ARGS_ASSERT_SETLOCALE_FAILURE_PANIC_I; + +#ifdef USE_C_BACKTRACE + dump_c_backtrace(Perl_debug_log, 20, 1); +#endif + + SETLOCALE_UNLOCK; + + if (current == NULL) { + current = querylocale_i(cat_index); + } + + RESTORE_ERRNO; + Perl_croak(aTHX_ "panic: %s: %d:(%d): Can't change locale for %s(%d)" + " from '%s' to '%s'; errno=%d\n", + __FILE__, caller_0_line, caller_1_line, name, cat, + current, failed, errno); + NOT_REACHED; /* NOTREACHED */ +} + STATIC void S_set_numeric_radix(pTHX_ const bool use_locale) { diff --git a/proto.h b/proto.h index 27c2cd5370c0..3cc78d1c8485 100644 --- a/proto.h +++ b/proto.h @@ -5134,6 +5134,11 @@ STATIC void S_restore_switched_locale(pTHX_ const int category, const char * con #define PERL_ARGS_ASSERT_RESTORE_SWITCHED_LOCALE STATIC void S_set_numeric_radix(pTHX_ const bool use_locale); #define PERL_ARGS_ASSERT_SET_NUMERIC_RADIX +PERL_STATIC_NO_RET void S_setlocale_failure_panic_i(pTHX_ const unsigned int cat_index, const char * current, const char * failed, const line_t caller_0_line, const line_t caller_1_line) + __attribute__noreturn__; +#define PERL_ARGS_ASSERT_SETLOCALE_FAILURE_PANIC_I \ + assert(failed) + STATIC char* S_stdize_locale(pTHX_ char* locs); #define PERL_ARGS_ASSERT_STDIZE_LOCALE \ assert(locs)