From 108d513ea5bddb613bd3e7d613b5212d76114b1c Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Sat, 8 Apr 2023 13:38:51 -0600
Subject: [PATCH] S_parse_LC_ALL_string(): Add parameter

This tells the function to panic instead of returning failure upon
encountering an error.
---
 embed.fnc |  1 +
 embed.h   |  2 +-
 locale.c  | 11 +++++++++++
 proto.h   |  2 +-
 4 files changed, 14 insertions(+), 2 deletions(-)

diff --git a/embed.fnc b/embed.fnc
index cd72ddfc4ba4..80821f36bacd 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -4393,6 +4393,7 @@ S	|void	|give_perl_locale_control				\
 S	|parse_LC_ALL_string_return|parse_LC_ALL_string 		\
 				|NN const char *string			\
 				|NN const char **output 		\
+				|const bool panic_on_error		\
 				|const line_t caller_line
 #   else
 S	|void	|give_perl_locale_control				\
diff --git a/embed.h b/embed.h
index de2fef353438..284ec7e65b04 100644
--- a/embed.h
+++ b/embed.h
@@ -1295,7 +1295,7 @@
 #       endif
 #       if defined(LC_ALL)
 #         define give_perl_locale_control(a,b)  S_give_perl_locale_control(aTHX_ a,b)
-#         define parse_LC_ALL_string(a,b,c,d)   S_parse_LC_ALL_string(aTHX_ a,b,c,d)
+#         define parse_LC_ALL_string(a,b,c,d,e) S_parse_LC_ALL_string(aTHX_ a,b,c,d,e)
 #       else
 #         define give_perl_locale_control(a,b)  S_give_perl_locale_control(aTHX_ a,b)
 #       endif
diff --git a/locale.c b/locale.c
index 75fd9bda9ee3..7d29c7908145 100644
--- a/locale.c
+++ b/locale.c
@@ -234,6 +234,7 @@ S_positional_name_value_xlation(const char * locale, bool direction)
     /* This parses either notation */
     switch (parse_LC_ALL_string(locale,
                                 (const char **) &individ_locales,
+                                false,      /* Don't panic on error */
                                 __LINE__))
     {
       case invalid:
@@ -1087,6 +1088,7 @@ Perl_locale_panic(const char * msg,
 STATIC parse_LC_ALL_string_return
 S_parse_LC_ALL_string(pTHX_ const char * string,
                             const char ** output,
+                            const bool panic_on_error,
                             const line_t caller_line)
 {
     /* This function parses the value of the input 'string' which is expected
@@ -1119,6 +1121,8 @@ S_parse_LC_ALL_string(pTHX_ const char * string,
      * syntactic errors, and if found, returns 'invalid'.  'output' will not be
      * filled in that case, but the input state of it isn't necessarily
      * preserved.  Turning on -DL debugging will give details as to the error.
+     * If 'panic_on_error' is 'true', the function panics instead of returning
+     * on error, with a message giving the details.
      *
      */
 
@@ -1322,6 +1326,10 @@ S_parse_LC_ALL_string(pTHX_ const char * string,
 
     DEBUG_L(PerlIO_printf(Perl_debug_log, "%s", msg));
 
+    if (panic_on_error) {
+        locale_panic_via_(msg, __FILE__, caller_line);
+    }
+
     return invalid;
 }
 
@@ -1414,6 +1422,7 @@ S_stdize_locale(pTHX_ const int category,
     else {
         switch (parse_LC_ALL_string(input_locale,
                                     (const char **) & individ_locales,
+                                    false,    /* Don't panic on error */
                                     caller_line))
         {
           case invalid:
@@ -1893,6 +1902,7 @@ S_bool_setlocale_2008_i(pTHX_
     if (index == LC_ALL_INDEX_) {
         switch (parse_LC_ALL_string(new_locale,
                                     (const char **) &new_locales,
+                                    false,    /* Don't panic on error */
                                     caller_line))
         {
           case invalid:
@@ -2557,6 +2567,7 @@ S_find_locale_from_environment(pTHX_ const unsigned int index)
          * component of it.  Split the result into its individual components */
         switch (parse_LC_ALL_string(lc_all,
                                     (const char **) &locale_names,
+                                    false,    /* Don't panic on error */
                                     __LINE__))
         {
           case invalid:
diff --git a/proto.h b/proto.h
index b5e806176f5c..7af47f2a9c09 100644
--- a/proto.h
+++ b/proto.h
@@ -7032,7 +7032,7 @@ S_give_perl_locale_control(pTHX_ const char *lc_all_string, const line_t caller_
         assert(lc_all_string)
 
 STATIC bool
-S_parse_LC_ALL_string(pTHX_ const char *string, const char **output, bool *is_array, const line_t caller_line);
+S_parse_LC_ALL_string(pTHX_ const char *string, const char **output, bool *is_array, const bool panic_on_error, const line_t caller_line);
 #     define PERL_ARGS_ASSERT_PARSE_LC_ALL_STRING \
         assert(string); assert(output); assert(is_array)