locale.c: Change S_emulate_setlocale name and sig

It turns out this function is called only from places where we have the category index already computed; so change the signature to use the index and remove the re-calculation. It renames it to emulate_setlocale_i() to indicate that the category parameter is an index. This also means, that it's very unlikely that it will be called with an out-of-bounds value. Remove the debugging statement for that case (but retain the error return value).
Perl · Apr 30, 2021 · ef28466 · ef28466
1 parent d6b74e9
commit ef28466
Show file tree

Hide file tree

Showing 4 changed files with 26 additions and 50 deletions.
diff --git a/embed.fnc b/embed.fnc
@@ -3235,10 +3235,8 @@ S	|void	|new_ctype	|NN const char* newctype
 S	|void	|set_numeric_radix|const bool use_locale
 S	|void	|new_numeric	|NULLOK const char* newnum
 #    ifdef USE_POSIX_2008_LOCALE
-ST	|const char*|emulate_setlocale|const int category		\
-				    |NULLOK const char* locale		\
-				    |unsigned int index			\
-				    |const bool is_index_valid
+S	|const char*|emulate_setlocale_i|const unsigned int index	\
+				    |NULLOK const char* locale
 #    endif
 #    ifdef WIN32
 S	|char*	|win32_setlocale|int category|NULLOK const char* locale

diff --git a/embed.h b/embed.h
@@ -1701,7 +1701,7 @@
 #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)
-#define emulate_setlocale	S_emulate_setlocale
+#define emulate_setlocale_i(a,b)	S_emulate_setlocale_i(aTHX_ a,b)
 #      endif
 #      if defined(WIN32)
 #define win32_setlocale(a,b)	S_win32_setlocale(aTHX_ a,b)

diff --git a/locale.c b/locale.c
@@ -412,8 +412,9 @@ S_category_name(const int category)
  * search through the array (as the actual numbers may not be small contiguous
  * positive integers which would lend themselves to array lookup). */
 #  define do_setlocale_c(cat, locale)                                       \
-                        emulate_setlocale(cat, locale, cat ## _INDEX_, TRUE)
-#  define do_setlocale_r(cat, locale) emulate_setlocale(cat, locale, 0, FALSE)
+                        emulate_setlocale_i(cat ## _INDEX_, locale)
+#  define do_setlocale_r(cat, locale)                                       \
+                emulate_setlocale_i(get_category_index(cat, locale), locale)
 
 #  if ! defined(__GLIBC__) || ! defined(USE_LOCALE_MESSAGES)
 
@@ -486,11 +487,7 @@ STATIC const int category_masks[] = {
                             };
 
 STATIC const char *
-S_emulate_setlocale(const int category,
-                    const char * locale,
-                    unsigned int index,
-                    const bool is_index_valid
-                   )
+S_emulate_setlocale_i(pTHX_ const unsigned int index, const char * locale)
 {
     /* This function effectively performs a setlocale() on just the current
      * thread; thus it is thread-safe.  It does this by using the POSIX 2008
@@ -529,36 +526,16 @@ S_emulate_setlocale(const int category,
      * think should happen for "".
      */
 
-    int mask;
     locale_t old_obj;
     locale_t new_obj;
-    dTHX;
-
-    DEBUG_Lv(PerlIO_printf(Perl_debug_log,
-             "%s:%d: emulate_setlocale input=%d (%s), \"%s\", %d, %d\n",
-             __FILE__, __LINE__, category, category_name(category), locale,
-             index, is_index_valid));
-
-    /* If the input mask might be incorrect, calculate the correct one */
-    if (! is_index_valid) {
-        index = get_category_index(category, locale);
-
-        if (index > NOMINAL_LC_ALL_INDEX) {
-
-        /* Here, we don't know about this category, so can't handle it.
-         * Fallback to the early POSIX usages */
-        Perl_warner(aTHX_ packWARN(WARN_LOCALE),
-                            "Unknown locale category %d; can't set it to %s\n",
-                                                     category, locale);
-        return NULL;
-        }
+    int mask;
+    int category;
 
-        DEBUG_Lv(PerlIO_printf(Perl_debug_log,
-                 "%s:%d: index is %d for %s\n",
-                 __FILE__, __LINE__, index, category_names[index]));
-    }
+    PERL_ARGS_ASSERT_EMULATE_SETLOCALE_I;
+    assert(index <= NOMINAL_LC_ALL_INDEX);
 
     mask = category_masks[index];
+    category = categories[index];
 
     DEBUG_Lv(PerlIO_printf(Perl_debug_log,
              "%s:%d: category name is %s; mask is 0x%x\n",
@@ -792,7 +769,7 @@ S_emulate_setlocale(const int category,
                                                 && strNE(env_override, ""))
                                                ? env_override
                                                : default_name;
-                    if (! emulate_setlocale(categories[i], this_locale, i, TRUE))
+                    if (! emulate_setlocale_i(i, this_locale))
                     {
                         return NULL;
                     }
@@ -817,7 +794,7 @@ S_emulate_setlocale(const int category,
                      * to update our records, and we've just done that for the
                      * individual categories in the loop above, and doing so
                      * would cause LC_ALL to be done as well */
-                    return emulate_setlocale(LC_ALL, NULL, LC_ALL_INDEX_, TRUE);
+                    return emulate_setlocale_i(LC_ALL_INDEX_, NULL);
                 }
             }
         }
@@ -843,7 +820,7 @@ S_emulate_setlocale(const int category,
          * all the individual categories to "C", and override the furnished
          * ones below */
         for (i = 0; i < LC_ALL_INDEX_; i++) {
-            if (! emulate_setlocale(categories[i], "C", i, TRUE)) {
+            if (! emulate_setlocale_i(i, "C")) {
                 return NULL;
             }
         }
@@ -903,7 +880,7 @@ S_emulate_setlocale(const int category,
                 assert(category == LC_ALL);
                 individ_locale = Perl_form(aTHX_ "%.*s",
                                     (int) (name_end - name_start), name_start);
-                if (! emulate_setlocale(categories[i], individ_locale, i, TRUE))
+                if (! emulate_setlocale_i(i, individ_locale))
                 {
                     return NULL;
                 }
@@ -941,21 +918,21 @@ S_emulate_setlocale(const int category,
     old_obj = uselocale(PL_C_locale_obj);
 
     DEBUG_Lv(PerlIO_printf(Perl_debug_log,
-             "%s:%d: emulate_setlocale was using %p\n",
+             "%s:%d: emulate_setlocale_i was using %p\n",
              __FILE__, __LINE__, old_obj));
 
     if (! old_obj) {
             dSAVE_ERRNO;
         DEBUG_L(PerlIO_printf(Perl_debug_log,
-                               "%s:%d: emulate_setlocale switching to C"
+                               "%s:%d: emulate_setlocale_i switching to C"
                                " failed: %d\n", __FILE__, __LINE__, GET_ERRNO));
             RESTORE_ERRNO;
 
         return NULL;
     }
 
     DEBUG_Lv(PerlIO_printf(Perl_debug_log,
-                      "%s:%d: emulate_setlocale now using %p\n",
+             "%s:%d: emulate_setlocale_i now using %p\n",
              __FILE__, __LINE__, PL_C_locale_obj));
 
     /* If this call is to switch to the LC_ALL C locale, it already exists, and
@@ -993,7 +970,7 @@ S_emulate_setlocale(const int category,
             dSAVE_ERRNO;
 
             DEBUG_L(PerlIO_printf(Perl_debug_log,
-                              "%s:%d: emulate_setlocale creating new object"
+                    "%s:%d: emulate_setlocale_i creating new object"
                     " failed: %d\n", __FILE__, __LINE__, GET_ERRNO));
 
             if (! uselocale(old_obj)) {
@@ -1009,7 +986,7 @@ S_emulate_setlocale(const int category,
 
         DEBUG_Lv(STMT_START {
             PerlIO_printf(Perl_debug_log,
-                          "%s:%d: emulate_setlocale created %p",
+                                  "%s:%d: emulate_setlocale_i created %p",
                           __FILE__, __LINE__, new_obj);
                     if (old_obj) PerlIO_printf(Perl_debug_log,
                               "; should have freed %p", old_obj);
@@ -1021,7 +998,7 @@ S_emulate_setlocale(const int category,
             dSAVE_ERRNO;
 
             DEBUG_L(PerlIO_printf(Perl_debug_log,
-                              "%s:%d: emulate_setlocale switching to new object"
+                    "%s:%d: emulate_setlocale_i switching to new object"
                     " failed\n", __FILE__, __LINE__));
 
             if (! uselocale(old_obj)) {
@@ -1038,7 +1015,7 @@ S_emulate_setlocale(const int category,
     }
 
     DEBUG_Lv(PerlIO_printf(Perl_debug_log,
-                      "%s:%d: emulate_setlocale now using %p\n",
+             "%s:%d: emulate_setlocale_i now using %p\n",
              __FILE__, __LINE__, new_obj));
 
     /* We are done, except for updating our records (if the system doesn't keep
@@ -5187,6 +5164,7 @@ multi-thread operation.
 void
 Perl_switch_to_global_locale()
 {
+    dTHX;
 
 #ifdef USE_THREAD_SAFE_LOCALE
 #  ifdef WIN32

diff --git a/proto.h b/proto.h
@@ -5140,8 +5140,8 @@ STATIC char*	S_stdize_locale(pTHX_ char* locs);
 STATIC const char*	S_switch_category_locale_to_template(pTHX_ const int switch_category, const int template_category, const char * template_locale);
 #define PERL_ARGS_ASSERT_SWITCH_CATEGORY_LOCALE_TO_TEMPLATE
 #    if defined(USE_POSIX_2008_LOCALE)
-STATIC const char*	S_emulate_setlocale(const int category, const char* locale, unsigned int index, const bool is_index_valid);
-#define PERL_ARGS_ASSERT_EMULATE_SETLOCALE
+STATIC const char*	S_emulate_setlocale_i(pTHX_ const unsigned int index, const char* locale);
+#define PERL_ARGS_ASSERT_EMULATE_SETLOCALE_I
 #    endif
 #    if defined(WIN32)
 STATIC char*	S_win32_setlocale(pTHX_ int category, const char* locale);