locale.c: Refactor internal debugging function

setlocale_debug_string() variants now use Perl_form, a function I didn't know existed when I originally wrote this code.
Perl · May 6, 2021 · 5aecce3 · 5aecce3
1 parent 611371f
commit 5aecce3
Show file tree

Hide file tree

Showing 4 changed files with 37 additions and 33 deletions.
diff --git a/embed.fnc b/embed.fnc
@@ -3338,9 +3338,11 @@ S	|void	|print_collxfrm_input_and_return		\
 			    |NULLOK const char * xbuf		\
 			    |const STRLEN xlen			\
 			    |const bool is_utf8
-STR	|char *	|setlocale_debug_string_i|const unsigned cat_index	    \
-					|NULLOK const char* const locale    \
-					|NULLOK const char* const retval
+SR	|char *	|my_setlocale_debug_string_i			\
+			    |const unsigned cat_index		\
+			    |NULLOK const char* locale		\
+			    |NULLOK const char* retval		\
+			    |const line_t line
 #    endif
 #  endif
 #  ifdef DEBUGGING

diff --git a/embed.h b/embed.h
@@ -1616,8 +1616,8 @@
 #    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 my_setlocale_debug_string_i(a,b,c,d)	S_my_setlocale_debug_string_i(aTHX_ a,b,c,d)
 #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
 #    endif
 #    if defined(PERL_IN_PAD_C)

diff --git a/locale.c b/locale.c
@@ -196,6 +196,8 @@ static const char C_thousands_sep[] = "";
 #ifdef USE_LOCALE
 
 #  ifdef DEBUGGING
+#    define setlocale_debug_string_i(index, locale, result)                 \
+            my_setlocale_debug_string_i(index, locale, result, __LINE__)
 #    define setlocale_debug_string_c(category, locale, result)              \
                 setlocale_debug_string_i(category##_INDEX_, locale, result)
 #    define setlocale_debug_string_r(category, locale, result)              \
@@ -6639,48 +6641,48 @@ Perl_sync_locale()
 #if defined(DEBUGGING) && defined(USE_LOCALE)
 
 STATIC char *
-S_setlocale_debug_string_i(const unsigned cat_index,
-                           const char* const locale, /* Optional locale name */
+S_my_setlocale_debug_string_i(pTHX_
+                              const unsigned cat_index,
+                              const char* locale, /* Optional locale name */
 
-                            /* return value from setlocale() when attempting to
-                             * set 'category' to 'locale' */
-                            const char* const retval)
+                              /* return value from setlocale() when attempting
+                               * to set 'category' to 'locale' */
+                              const char* retval,
+
+                              const line_t line)
 {
     /* Returns a pointer to a NUL-terminated string in static storage with
      * added text about the info passed in.  This is not thread safe and will
      * be overwritten by the next call, so this should be used just to
      * formulate a string to immediately print or savepv() on. */
 
-    static char ret[256];
-    assert(cat_index <= NOMINAL_LC_ALL_INDEX);
+    const char * locale_quote;
+    const char * retval_quote;
 
-    my_strlcpy(ret, "setlocale(", sizeof(ret));
-    my_strlcat(ret, category_names[cat_index], sizeof(ret));
-    my_strlcat(ret, ", ", sizeof(ret));
+    assert(cat_index <= NOMINAL_LC_ALL_INDEX);
+    PERL_UNUSED_ARG(line);  /* Currently unused */
 
-    if (locale) {
-        my_strlcat(ret, "\"", sizeof(ret));
-        my_strlcat(ret, locale, sizeof(ret));
-        my_strlcat(ret, "\"", sizeof(ret));
+    if (locale == NULL) {
+        locale_quote = "";
+        locale = "NULL";
     }
     else {
-        my_strlcat(ret, "NULL", sizeof(ret));
+        locale_quote = "\"";
     }
 
-    my_strlcat(ret, ") returned ", sizeof(ret));
-
-    if (retval) {
-        my_strlcat(ret, "\"", sizeof(ret));
-        my_strlcat(ret, retval, sizeof(ret));
-        my_strlcat(ret, "\"", sizeof(ret));
+    if (retval == NULL) {
+        retval_quote = "";
+        retval = "NULL";
     }
     else {
-        my_strlcat(ret, "NULL", sizeof(ret));
+        retval_quote = "\"";
     }
 
-    assert(strlen(ret) < sizeof(ret));
-
-    return ret;
+    return Perl_form(aTHX_
+                     "setlocale(%s(%d), %s%s%s) returned %s%s%s\n",
+                     category_names[cat_index], categories[cat_index],
+                     locale_quote, locale, locale_quote,
+                     retval_quote, retval, retval_quote);
 }
 
 #endif

diff --git a/proto.h b/proto.h
@@ -4636,13 +4636,13 @@ 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 char *	S_my_setlocale_debug_string_i(pTHX_ const unsigned cat_index, const char* locale, const char* retval, const line_t line)
+			__attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_MY_SETLOCALE_DEBUG_STRING_I
+
 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)
-STATIC char *	S_setlocale_debug_string_i(const unsigned cat_index, const char* const locale, const char* const retval)
-			__attribute__warn_unused_result__;
-#define PERL_ARGS_ASSERT_SETLOCALE_DEBUG_STRING_I
-
 #    endif
 #  endif
 #  if defined(PERL_IN_PAD_C)