This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
locale.c: Add S_get_LC_ALL display()
authorKarl Williamson <khw@cpan.org>
Tue, 9 Aug 2022 23:06:07 +0000 (17:06 -0600)
committerKarl Williamson <khw@cpan.org>
Thu, 8 Sep 2022 22:20:46 +0000 (16:20 -0600)
This encapsulates a common paradigm, helpful for debugging

It requires the calculate_LC_ALL to be additionally available when there
is no LC_ALL.

embed.fnc
embed.h
locale.c
proto.h

index eba677a..33faff7 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -3373,16 +3373,21 @@ S       |locale_t   |use_curlocale_scratch
 S      |const char *|setlocale_from_aggregate_LC_ALL                   \
                                |NN const char * locale                 \
                                |const line_t line
-#      ifdef USE_QUERYLOCALE
-S      |const char *|calculate_LC_ALL|const locale_t cur_obj
-#      else
-S      |const char *|calculate_LC_ALL|NN const char ** individ_locales
+#      ifndef USE_QUERYLOCALE
 S      |const char*|update_PL_curlocales_i|const unsigned int index    \
                                    |NN const char * new_locale         \
                                    |recalc_lc_all_t recalc_LC_ALL
 S      |const char *|find_locale_from_environment|const unsigned int index
 #      endif
 #    endif
+#    if defined(USE_POSIX_2008_LOCALE) && defined(USE_QUERYLOCALE)
+S      |const char *|calculate_LC_ALL|const locale_t cur_obj
+#    else
+:          regen/embed.pl can't currently cope with 'elif'
+#      if defined(USE_POSIX_2008_LOCALE) || ! defined(LC_ALL)
+S      |const char *|calculate_LC_ALL|NN const char ** individ_locales
+#      endif
+#    endif
 #    ifdef WIN32
 S      |char*  |win32_setlocale|int category|NULLOK const char* locale
 pTC    |wchar_t *|Win_utf8_string_to_wstring|NULLOK const char * utf8_string
@@ -3413,6 +3418,7 @@ S |void   |print_collxfrm_input_and_return                \
 STR    |char * |setlocale_debug_string_i|const unsigned cat_index          \
                                        |NULLOK const char* const locale    \
                                        |NULLOK const char* const retval
+S      |const char *|get_LC_ALL_display
 #    endif
 #  endif
 #  ifdef DEBUGGING
diff --git a/embed.h b/embed.h
index 377f33a..7b88a09 100644 (file)
--- a/embed.h
+++ b/embed.h
 #  if !(defined(PERL_USE_3ARG_SIGHANDLER))
 #define sighandler             Perl_sighandler
 #  endif
-#  if !(defined(USE_QUERYLOCALE))
+#  if !(defined(USE_POSIX_2008_LOCALE) && defined(USE_QUERYLOCALE))
 #    if defined(PERL_IN_LOCALE_C)
 #      if defined(USE_LOCALE)
-#        if defined(USE_POSIX_2008_LOCALE)
+#        if defined(USE_POSIX_2008_LOCALE) || ! defined(LC_ALL)
 #define calculate_LC_ALL(a)    S_calculate_LC_ALL(aTHX_ a)
-#define find_locale_from_environment(a)        S_find_locale_from_environment(aTHX_ a)
-#define update_PL_curlocales_i(a,b,c)  S_update_PL_curlocales_i(aTHX_ a,b,c)
 #        endif
 #      endif
 #    endif
 #define new_he()               S_new_he(aTHX)
 #    endif
 #  endif
+#  if !defined(USE_QUERYLOCALE)
+#    if defined(PERL_IN_LOCALE_C)
+#      if defined(USE_LOCALE)
+#        if defined(USE_POSIX_2008_LOCALE)
+#define find_locale_from_environment(a)        S_find_locale_from_environment(aTHX_ a)
+#define update_PL_curlocales_i(a,b,c)  S_update_PL_curlocales_i(aTHX_ a,b,c)
+#        endif
+#      endif
+#    endif
+#  endif
 #  if !defined(WIN32)
 #define do_exec3(a,b,c)                Perl_do_exec3(aTHX_ a,b,c)
 #  endif
 #    if defined(PERL_IN_LOCALE_C)
 #define print_bytes_for_locale(a,b,c)  S_print_bytes_for_locale(aTHX_ a,b,c)
 #      if defined(USE_LOCALE)
+#define get_LC_ALL_display()   S_get_LC_ALL_display(aTHX)
 #define print_collxfrm_input_and_return(a,b,c,d,e)     S_print_collxfrm_input_and_return(aTHX_ a,b,c,d,e)
 #define setlocale_debug_string_i       S_setlocale_debug_string_i
 #      endif
 #define my_querylocale_i(a)    S_my_querylocale_i(aTHX_ a)
 #define setlocale_from_aggregate_LC_ALL(a,b)   S_setlocale_from_aggregate_LC_ALL(aTHX_ a,b)
 #define use_curlocale_scratch()        S_use_curlocale_scratch(aTHX)
-#        if defined(USE_QUERYLOCALE)
+#      endif
+#      if defined(USE_POSIX_2008_LOCALE) && defined(USE_QUERYLOCALE)
 #define calculate_LC_ALL(a)    S_calculate_LC_ALL(aTHX_ a)
-#        endif
 #      endif
 #      if defined(WIN32)
 #define win32_setlocale(a,b)   S_win32_setlocale(aTHX_ a,b)
index 1abf549..f6528b8 100644 (file)
--- a/locale.c
+++ b/locale.c
@@ -1407,7 +1407,7 @@ S_stdize_locale(pTHX_ const int category,
     return retval;
 }
 
-#if defined(USE_POSIX_2008_LOCALE)
+#if defined(USE_POSIX_2008_LOCALE) || ! defined(LC_ALL)
 
 STATIC
 const char *
@@ -1464,7 +1464,7 @@ S_calculate_LC_ALL(pTHX_ const char ** individ_locales)
 
     /* First calculate the needed size for the string listing the categories
      * and their locales. */
-    for (i = 0; i < LC_ALL_INDEX_; i++) {
+    for (i = 0; i < NOMINAL_LC_ALL_INDEX; i++) {
 
 #  ifdef USE_QUERYLOCALE
         const char * entry = querylocale_l(i, cur_obj);
@@ -1484,7 +1484,7 @@ S_calculate_LC_ALL(pTHX_ const char ** individ_locales)
     SAVEFREEPV(Newxz(aggregate_locale, names_len, char));
 
     /* Then fill it in */
-    for (i = 0; i < LC_ALL_INDEX_; i++) {
+    for (i = 0; i < NOMINAL_LC_ALL_INDEX; i++) {
         Size_t new_len;
 
 #  ifdef USE_QUERYLOCALE
@@ -1530,7 +1530,34 @@ S_calculate_LC_ALL(pTHX_ const char ** individ_locales)
 
     return aggregate_locale;
 }
-#endif /*defined(USE_POSIX_2008_LOCALE)*/
+
+#endif
+
+#if defined(USE_LOCALE) && defined(DEBUGGING)
+
+STATIC const char *
+S_get_LC_ALL_display(pTHX)
+{
+
+#  ifdef LC_ALL
+
+    return querylocale_c(LC_ALL);
+
+#  else
+
+    const char * curlocales[NOMINAL_LC_ALL_INDEX];
+
+    for (unsigned i = 0; i < NOMINAL_LC_ALL_INDEX; i++) {
+        curlocales[i] = querylocale_i(i);
+    }
+
+    return calculate_LC_ALL(curlocales);
+
+#  endif
+
+}
+
+#endif
 
 STATIC void
 S_setlocale_failure_panic_i(pTHX_
diff --git a/proto.h b/proto.h
index 4d695a5..52e1f46 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -4709,18 +4709,13 @@ PERL_CALLCONV Signal_t  Perl_sighandler(int sig)
 #define PERL_ARGS_ASSERT_SIGHANDLER
 
 #endif
-#if !(defined(USE_QUERYLOCALE))
+#if !(defined(USE_POSIX_2008_LOCALE) && defined(USE_QUERYLOCALE))
 #  if defined(PERL_IN_LOCALE_C)
 #    if defined(USE_LOCALE)
-#      if defined(USE_POSIX_2008_LOCALE)
+#      if defined(USE_POSIX_2008_LOCALE) || ! defined(LC_ALL)
 STATIC const char *    S_calculate_LC_ALL(pTHX_ const char ** individ_locales);
 #define PERL_ARGS_ASSERT_CALCULATE_LC_ALL      \
        assert(individ_locales)
-STATIC const char *    S_find_locale_from_environment(pTHX_ const unsigned int index);
-#define PERL_ARGS_ASSERT_FIND_LOCALE_FROM_ENVIRONMENT
-STATIC const char*     S_update_PL_curlocales_i(pTHX_ const unsigned int index, const char * new_locale, recalc_lc_all_t recalc_LC_ALL);
-#define PERL_ARGS_ASSERT_UPDATE_PL_CURLOCALES_I        \
-       assert(new_locale)
 #      endif
 #    endif
 #  endif
@@ -5031,6 +5026,19 @@ STATIC void      S_validate_suid(pTHX_ PerlIO *rsfp);
 /* PERL_CALLCONV void  CopFILEGV_set(pTHX_ COP * c, GV * gv); */
 #define PERL_ARGS_ASSERT_COPFILEGV_SET
 #endif
+#if !defined(USE_QUERYLOCALE)
+#  if defined(PERL_IN_LOCALE_C)
+#    if defined(USE_LOCALE)
+#      if defined(USE_POSIX_2008_LOCALE)
+STATIC const char *    S_find_locale_from_environment(pTHX_ const unsigned int index);
+#define PERL_ARGS_ASSERT_FIND_LOCALE_FROM_ENVIRONMENT
+STATIC const char*     S_update_PL_curlocales_i(pTHX_ const unsigned int index, const char * new_locale, recalc_lc_all_t recalc_LC_ALL);
+#define PERL_ARGS_ASSERT_UPDATE_PL_CURLOCALES_I        \
+       assert(new_locale)
+#      endif
+#    endif
+#  endif
+#endif
 #if !defined(WIN32)
 PERL_CALLCONV bool     Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
                        __attribute__visibility__("hidden");
@@ -5087,6 +5095,8 @@ STATIC void       S_print_bytes_for_locale(pTHX_ const char * const s, const char * co
 #define PERL_ARGS_ASSERT_PRINT_BYTES_FOR_LOCALE        \
        assert(s); assert(e)
 #    if defined(USE_LOCALE)
+STATIC const char *    S_get_LC_ALL_display(pTHX);
+#define PERL_ARGS_ASSERT_GET_LC_ALL_DISPLAY
 STATIC void    S_print_collxfrm_input_and_return(pTHX_ const char * s, const char * e, const char * xbuf, const STRLEN xlen, const bool is_utf8);
 #define PERL_ARGS_ASSERT_PRINT_COLLXFRM_INPUT_AND_RETURN       \
        assert(s); assert(e)
@@ -5707,10 +5717,10 @@ STATIC const char *     S_setlocale_from_aggregate_LC_ALL(pTHX_ const char * locale,
        assert(locale)
 STATIC locale_t        S_use_curlocale_scratch(pTHX);
 #define PERL_ARGS_ASSERT_USE_CURLOCALE_SCRATCH
-#      if defined(USE_QUERYLOCALE)
+#    endif
+#    if defined(USE_POSIX_2008_LOCALE) && defined(USE_QUERYLOCALE)
 STATIC const char *    S_calculate_LC_ALL(pTHX_ const locale_t cur_obj);
 #define PERL_ARGS_ASSERT_CALCULATE_LC_ALL
-#      endif
 #    endif
 #    if defined(WIN32)
 PERL_CALLCONV wchar_t *        Perl_Win_utf8_string_to_wstring(const char * utf8_string);