S_calculate_LC_ALL_string: Add parameter

This parameter is set only when this function is being called by
Perl_setlocale().  This is purely for performance  It causes this
function to use a particular buffer and avoid extra copying.

embed.fnc

@@ -4332,6 +4332,7 @@ S	|void	|populate_hash_from_localeconv				\
 S	|const char *|calculate_LC_ALL_string					\
 				|NULLOK const char **category_locales_list	\
 				|const calc_LC_ALL_format format		\
+				|const bool return_in_setlocale_buf		\
 				|const line_t caller_line
 RS	|unsigned int|get_category_index_helper 			\
 				|const int category			\

embed.h

@@ -1269,7 +1269,7 @@
 #       define populate_hash_from_localeconv(a,b,c,d,e) S_populate_hash_from_localeconv(aTHX_ a,b,c,d,e)
 #     endif
 #     if defined(USE_LOCALE)
-#       define calculate_LC_ALL_string(a,b,c)   S_calculate_LC_ALL_string(aTHX_ a,b,c)
+#       define calculate_LC_ALL_string(a,b,c,d) S_calculate_LC_ALL_string(aTHX_ a,b,c,d)
 #       define get_category_index_helper(a,b,c) S_get_category_index_helper(aTHX_ a,b,c)
 #       define mortalized_pv_copy(a)            S_mortalized_pv_copy(aTHX_ a)
 #       define new_LC_ALL(a,b)                  S_new_LC_ALL(aTHX_ a,b)

locale.c

@@ -253,7 +253,11 @@ S_positional_name_value_xlation(const char * locale, bool direction)
                                      ? EXTERNAL_FORMAT_FOR_SET
                                      : INTERNAL_FORMAT;
         const char * retval = calculate_LC_ALL_string(individ_locales,
-                                                      format, __LINE__);
+                                                      format,
+                                                      false,   /* Use a
+                                                                  temporary for
+                                                                  result */
+                                                      __LINE__);
 
         for (unsigned int i = 0; i < LC_ALL_INDEX_; i++) {
             Safefree(individ_locales[i]);
@@ -1879,6 +1883,7 @@ S_stdize_locale(pTHX_ const int category,
             retval = (char *) calculate_LC_ALL_string(
                                             (const char **) &individ_locales,
                                             EXTERNAL_FORMAT_FOR_SET,
+                                            false, /* Use a temporary */
                                             caller_line);
         }
 
@@ -2157,6 +2162,8 @@ S_querylocale_2008_i(pTHX_ const unsigned int index, const line_t caller_line)
          * function updates PL_curlocales[LC_ALL_INDEX_] ) */
         if (index == LC_ALL_INDEX_ && PL_curlocales[LC_ALL_INDEX_] == NULL) {
             calculate_LC_ALL_string(PL_curlocales, INTERNAL_FORMAT,
+                                    false,    /* Use a temporary for the
+                                                 (discarded) result */
                                     caller_line);
         }
 
@@ -2172,6 +2179,8 @@ S_querylocale_2008_i(pTHX_ const unsigned int index, const line_t caller_line)
          * individual categories */
         if (index == LC_ALL_INDEX_) {
             retval = calculate_LC_ALL_string(NULL, INTERNAL_FORMAT,
+                                             false,    /* Use a temporary for
+                                                          the result */
                                              caller_line);
         }
         else {
@@ -2717,6 +2726,7 @@ STATIC
 const char *
 S_calculate_LC_ALL_string(pTHX_ const char ** category_locales_list,
                                 const calc_LC_ALL_format format,
+                                const bool return_in_setlocale_buf,
                                 const line_t caller_line)
 {
     PERL_ARGS_ASSERT_CALCULATE_LC_ALL_STRING;
@@ -2749,8 +2759,12 @@ S_calculate_LC_ALL_string(pTHX_ const char ** category_locales_list,
      *  2) NULL, to indicate to use querylocale_i() to get each individual
      *     value.
      *
-     * This function returns a mortalized string containing the locale name(s)
-     * of LC_ALL.
+     * The caller sets 'return_in_setlocale_buf' to
+     *  true)   the returned string is to be in the per-thread buffer that
+     *          Perl_setlocale() returns, so it can be returned directly by
+     *          that function to its caller with no extra copying.  This is
+     *          only vaid for an EXTERNAL-type format.
+     *  false)  the returned string is mortalized.
      *
      * querylocale(), on systems that have it, doesn't tend to work for LC_ALL.
      * So we have to construct the answer ourselves based on the passed in
@@ -2805,7 +2819,7 @@ S_calculate_LC_ALL_string(pTHX_ const char ** category_locales_list,
     /* But if there are ignored categories, those will be set to "C", so try an
      * arbitrary category, and if it isn't C, we know immediately that the
      * locales are disparate.  (The #if conditionals are to handle the case
-     * where LC_NUMERIC_INDEX_ is 0.  We don't want to use LC_NUMERIC to
+     * where LC_NUMERIC_INDEX_ is 0.. We don't want to use LC_NUMERIC to
      * compare, as that may be different between external and internal forms.)
      * */
 #    if ! defined(USE_LOCALE_NUMERIC)
@@ -2878,14 +2892,31 @@ S_calculate_LC_ALL_string(pTHX_ const char ** category_locales_list,
 
     /* If all categories have the same locale, we already know the answer */
     if (! disparate) {
+        if (return_in_setlocale_buf) {
+            retval = save_to_buffer(locales_list[0],
+                                    &PL_setlocale_buf, &PL_setlocale_bufsize);
+        }
+        else {      /* Return in a temporary */
             retval = savepv(locales_list[0]);
             SAVEFREEPV(retval);
+        }
     }
     else {  /* Here, not all categories have the same locale */
         char * writable_alias;
 
+        if (! return_in_setlocale_buf) {    /* Create a temporary */
             Newx(writable_alias, total_len, char);
             SAVEFREEPV(writable_alias);
+        }
+        else {  /* Write directly to PL_setlocale_buf, being sure it is resized
+                   to be large enough for the aggregated string. */
+            if (total_len > PL_setlocale_bufsize) {
+                PL_setlocale_bufsize = total_len;
+                Renew(PL_setlocale_buf, PL_setlocale_bufsize, char);
+            }
+
+            writable_alias = (char *) PL_setlocale_buf;
+        }
 
         writable_alias[0] = '\0';
 
@@ -3156,7 +3187,9 @@ S_find_locale_from_environment(pTHX_ const unsigned int index)
         return locale_names[0];
     }
 
-    return calculate_LC_ALL_string(locale_names, INTERNAL_FORMAT, __LINE__);
+    return calculate_LC_ALL_string(locale_names, INTERNAL_FORMAT,
+                                   false,   /* Use a temporary for result */
+                                   __LINE__);
 }
 
 #endif
@@ -3167,6 +3200,7 @@ STATIC const char *
 S_get_LC_ALL_display(pTHX)
 {
     return calculate_LC_ALL_string(NULL, INTERNAL_FORMAT,
+                                   false,  /* Use temporary for result */
                                    __LINE__);
 }
 
@@ -7282,6 +7316,8 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
 #  else
                 name = calculate_LC_ALL_string(curlocales,
                                                INTERNAL_FORMAT,
+                                               false,  /* Use temporary for
+                                                          result */
                                                __LINE__);
 #  endif
                 description = GET_DESCRIPTION(trial, name);
@@ -7323,6 +7359,8 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
                  * human readable than the positional notation */
                 name = calculate_LC_ALL_string(system_locales,
                                                INTERNAL_FORMAT,
+                                               false,   /* Use a temporary for
+                                                           result */
                                                __LINE__);
                 description = "what the system says";