locale.c: Add panic check/message

This panic is done when a setlocale unexpectedly fails.
Perl · Apr 17, 2021 · afd3073 · afd3073
1 parent 5229d5d
commit afd3073
Show file tree

Hide file tree

Showing 4 changed files with 59 additions and 3 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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)