locale.c: Create new macros for just querying locale

There are two sets of names, which immediately indicate if the result
can be relied on to be thread level or must be assumed to be global to
the whole process.  At the moment they all expand to the same thing,
since on a threadless perl, it's a don't care; and on a threaded perl,
they are all already thread-level, in the Configurations we support.

Future commits will cause the macros to diverge, and comments will be
added then.

For POSIX 2008, this commit causes queries to go directly to the query
function, avoiding S_emulate_setlocale_i() completely.

1 files changed, 29 insertions, 27 deletions

diff --git a/locale.c b/locale.c
index 1dc2b4451a..b8ea022ef0 100644
--- a/locale.c
+++ b/locale.c
@@ -388,6 +388,11 @@ S_category_name(const int category)
 #  define do_setlocale_c(cat, locale)  porcelain_setlocale(cat, locale)
 #  define do_setlocale_i(i, locale)  do_setlocale_c(categories[i], locale)
 #  define do_setlocale_r(cat, locale)   do_setlocale_c(cat, locale)
+
+#  define querylocale_c(cat)        porcelain_setlocale(cat, NULL)
+#  define querylocale_r(cat)        querylocale_c(cat)
+#  define querylocale_i(i)          querylocale_c(categories[i])
+
 #  define FIX_GLIBC_LC_MESSAGES_BUG(i)
 
 #else   /* Below uses POSIX 2008 */
@@ -404,6 +409,10 @@ S_category_name(const int category)
 #  define do_setlocale_r(cat, locale)                                       \
                     do_setlocale_i(get_category_index(cat, locale), locale)
 
+#  define querylocale_i(i)      my_querylocale_i(i)
+#  define querylocale_c(cat)    querylocale_i(cat##_INDEX_)
+#  define querylocale_r(cat)    querylocale_i(get_category_index(cat,NULL))
+
 #  if ! defined(__GLIBC__) || ! defined(USE_LOCALE_MESSAGES)
 
 #    define FIX_GLIBC_LC_MESSAGES_BUG(i)
@@ -787,7 +796,7 @@ S_emulate_setlocale_i(pTHX_ const unsigned int index, const char * locale)
                      * 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 my_querylocale_c(LC_ALL);
+                    return querylocale_c(LC_ALL);
                 }
             }
         }
@@ -887,7 +896,7 @@ S_emulate_setlocale_i(pTHX_ const unsigned int index, const char * locale)
          * what that now is */
         assert(category == LC_ALL);
 
-        return do_setlocale_c(LC_ALL, NULL);
+        return querylocale_c(LC_ALL);
     }   /* End of this being setlocale(LC_ALL,
            "LC_CTYPE=foo;LC_NUMERIC=bar;...") */
 
@@ -2180,21 +2189,21 @@ Perl_setlocale(const int category, const char * locale)
 
 #  ifdef USE_LOCALE_CTYPE
 
-            newlocale = savepv(do_setlocale_c(LC_CTYPE, NULL));
+            newlocale = savepv(querylocale_c(LC_CTYPE));
             new_ctype(newlocale);
             Safefree(newlocale);
 
 #  endif /* USE_LOCALE_CTYPE */
 #  ifdef USE_LOCALE_COLLATE
 
-            newlocale = savepv(do_setlocale_c(LC_COLLATE, NULL));
+            newlocale = savepv(querylocale_c(LC_COLLATE));
             new_collate(newlocale);
             Safefree(newlocale);
 
 #  endif
 #  ifdef USE_LOCALE_NUMERIC
 
-            newlocale = savepv(do_setlocale_c(LC_NUMERIC, NULL));
+            newlocale = savepv(querylocale_c(LC_NUMERIC));
             new_numeric(newlocale);
             Safefree(newlocale);
 
@@ -3405,11 +3414,11 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
         if (! setlocale_failure) {
             unsigned int j;
             for (j = 0; j < NOMINAL_LC_ALL_INDEX; j++) {
-                curlocales[j]
-                        = savepv(do_setlocale_r(categories[j], trial_locale));
+                curlocales[j] = do_setlocale_i(j, trial_locale);
                 if (! curlocales[j]) {
                     setlocale_failure = TRUE;
                 }
+                curlocales[j] = savepv(curlocales[j]);
                 DEBUG_LOCALE_INIT(j, trial_locale, curlocales[j]);
             }
 
@@ -3592,7 +3601,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
 
             for (j = 0; j < NOMINAL_LC_ALL_INDEX; j++) {
                 Safefree(curlocales[j]);
-                curlocales[j] = savepv(do_setlocale_r(categories[j], NULL));
+                curlocales[j] = savepv(querylocale_i(j));
                 DEBUG_LOCALE_INIT(j, NULL, curlocales[j]);
             }
         }
@@ -4304,8 +4313,8 @@ S_switch_category_locale_to_template(pTHX_ const int switch_category,
 
     /* Find the original locale of the category we may need to change, so that
      * it can be restored to later */
-    restore_to_locale = stdize_locale(savepv(do_setlocale_r(switch_category,
-                                                            NULL)));
+    restore_to_locale =
+                      stdize_locale(savepv(querylocale_r(switch_category)));
     if (! restore_to_locale) {
         Perl_croak(aTHX_
              "panic: %s: %d: Could not find current %s locale, errno=%d\n",
@@ -4314,7 +4323,7 @@ S_switch_category_locale_to_template(pTHX_ const int switch_category,
 
     /* If the locale of the template category wasn't passed in, find it now */
     if (template_locale == NULL) {
-        template_locale = do_setlocale_r(template_category, NULL);
+        template_locale = querylocale_r(template_category);
         if (! template_locale) {
             Perl_croak(aTHX_
              "panic: %s: %d: Could not find current %s locale, errno=%d\n",
@@ -4420,7 +4429,7 @@ Perl__is_cur_LC_category_utf8(pTHX_ int category)
 #  endif
 
     /* Get the desired category's locale */
-    save_input_locale = stdize_locale(savepv(do_setlocale_r(category, NULL)));
+    save_input_locale = stdize_locale(savepv(querylocale_r(category)));
     if (! save_input_locale) {
         Perl_croak(aTHX_
              "panic: %s: %d: Could not find current %s locale, errno=%d\n",
@@ -5040,7 +5049,7 @@ Perl_my_strerror(pTHX_ const int errnum)
         errstr = savepv(strerror(errnum));
     }
     else {
-        const char * save_locale = savepv(do_setlocale_c(LC_MESSAGES, NULL));
+        const char * save_locale = savepv(querylocale_c(LC_MESSAGES));
 
         do_setlocale_c(LC_MESSAGES, "C");
         errstr = savepv(strerror(errnum));
@@ -5108,7 +5117,7 @@ Perl_my_strerror(pTHX_ const int errnum)
     DEBUG_Lv(PerlIO_printf(Perl_debug_log,
                             "my_strerror called with errnum %d\n", errnum));
     if (! within_locale_scope) {
-        save_locale = do_setlocale_c(LC_MESSAGES, NULL);
+        save_locale = querylocale_c(LC_MESSAGES);
         if (! save_locale) {
             SETLOCALE_UNLOCK;
             Perl_croak(aTHX_
@@ -5244,22 +5253,15 @@ Perl_switch_to_global_locale()
     _configthreadlocale(_DISABLE_PER_THREAD_LOCALE);
 
 #  else
-#    ifdef HAS_QUERYLOCALE
-
-    setlocale(LC_ALL, querylocale(LC_ALL_MASK, uselocale((locale_t) 0)));
-
-#    else
 
     {
         unsigned int i;
 
         for (i = 0; i < LC_ALL_INDEX_; i++) {
-            setlocale(categories[i], do_setlocale_r(categories[i], NULL));
+            setlocale(categories[i], querylocale_i(i));
         }
     }
 
-#    endif
-
     uselocale(LC_GLOBAL_LOCALE);
 
 #  endif
@@ -5317,7 +5319,7 @@ Perl_sync_locale()
 
 #    ifdef HAS_QUERY_LOCALE
 
-        do_setlocale_c(LC_ALL, setlocale(LC_ALL, NULL));
+        void_setlocale_c(LC_ALL, querylocale_c(LC_ALL));
 
 #    else
 
@@ -5326,7 +5328,7 @@ Perl_sync_locale()
         /* We can't trust that we can read the LC_ALL format on the
          * platform, so do them individually */
         for (i = 0; i < LC_ALL_INDEX_; i++) {
-            do_setlocale_r(categories[i], setlocale(categories[i], NULL));
+            do_setlocale_r(categories[i], querylocale_i(i));
         }
 
 #    endif
@@ -5341,7 +5343,7 @@ Perl_sync_locale()
 #  endif
 #  ifdef USE_LOCALE_CTYPE
 
-    newlocale = savepv(do_setlocale_c(LC_CTYPE, NULL));
+    newlocale = savepv(querylocale_c(LC_CTYPE));
     DEBUG_Lv(PerlIO_printf(Perl_debug_log,
         "%s:%d: %s\n", __FILE__, __LINE__,
         setlocale_debug_string_c(LC_CTYPE, NULL, newlocale)));
@@ -5351,7 +5353,7 @@ Perl_sync_locale()
 #  endif /* USE_LOCALE_CTYPE */
 #  ifdef USE_LOCALE_COLLATE
 
-    newlocale = savepv(do_setlocale_c(LC_COLLATE, NULL));
+    newlocale = savepv(querylocale_c(LC_COLLATE));
     DEBUG_Lv(PerlIO_printf(Perl_debug_log,
         "%s:%d: %s\n", __FILE__, __LINE__,
         setlocale_debug_string_c(LC_COLLATE, NULL, newlocale)));
@@ -5361,7 +5363,7 @@ Perl_sync_locale()
 #  endif
 #  ifdef USE_LOCALE_NUMERIC
 
-    newlocale = savepv(do_setlocale_c(LC_NUMERIC, NULL));
+    newlocale = savepv(querylocale_c(LC_NUMERIC));
     DEBUG_Lv(PerlIO_printf(Perl_debug_log,
         "%s:%d: %s\n", __FILE__, __LINE__,
         setlocale_debug_string_c(LC_NUMERIC, NULL, newlocale)));