utf8.c: Extract code into separate function

This is in preparation for the next commit which will use this code in
multiple places

4 files changed, 35 insertions, 10 deletions

diff --git a/embed.fnc b/embed.fnc
index ea389e4155..763a17c4b3 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -2847,6 +2847,9 @@ sn	|NV|mulexp10	|NV value|I32 exponent
 #endif
 
 #if defined(PERL_IN_UTF8_C)
+sR	|HV *	|new_msg_hv |NN const char * const message		    \
+			    |U32 categories				    \
+			    |U32 flag
 sRM	|UV	|check_locale_boundary_crossing				    \
 		|NN const U8* const p					    \
 		|const UV result					    \
diff --git a/embed.h b/embed.h
index d1fe34ab66..5f2184ad92 100644
--- a/embed.h
+++ b/embed.h
@@ -1896,6 +1896,7 @@
 #define is_utf8_common(a,b,c,d)	S_is_utf8_common(aTHX_ a,b,c,d)
 #define is_utf8_common_with_len(a,b,c,d,e)	S_is_utf8_common_with_len(aTHX_ a,b,c,d,e)
 #define is_utf8_overlong_given_start_byte_ok	S_is_utf8_overlong_given_start_byte_ok
+#define new_msg_hv(a,b,c)	S_new_msg_hv(aTHX_ a,b,c)
 #define swash_scan_list_line(a,b,c,d,e,f,g)	S_swash_scan_list_line(aTHX_ a,b,c,d,e,f,g)
 #define swatch_get(a,b,c)	S_swatch_get(aTHX_ a,b,c)
 #define to_lower_latin1		S_to_lower_latin1
diff --git a/proto.h b/proto.h
index 485211540b..2e3f9653c4 100644
--- a/proto.h
+++ b/proto.h
@@ -5992,6 +5992,11 @@ PERL_STATIC_INLINE int	S_is_utf8_overlong_given_start_byte_ok(const U8 * const s
 	assert(s)
 #endif
 
+STATIC HV *	S_new_msg_hv(pTHX_ const char * const message, U32 categories, U32 flag)
+			__attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_NEW_MSG_HV	\
+	assert(message)
+
 STATIC U8*	S_swash_scan_list_line(pTHX_ U8* l, U8* const lend, UV* min, UV* max, UV* val, const bool wants_value, const U8* const typestr)
 			__attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_SWASH_SCAN_LIST_LINE	\
diff --git a/utf8.c b/utf8.c
index 21664d5cf8..18367f5126 100644
--- a/utf8.c
+++ b/utf8.c
@@ -101,6 +101,29 @@ Perl__force_out_malformed_utf8_message(pTHX_
     }
 }
 
+STATIC HV *
+S_new_msg_hv(pTHX_ const char * const message, /* The message text */
+                   U32 categories,  /* Packed warning categories */
+                   U32 flag)        /* Flag associated with this message */
+{
+    /* Creates, populates, and returns an HV* that describes an error message
+     * for the translators between UTF8 and code point */
+
+    SV* msg_sv = newSVpv(message, 0);
+    SV* category_sv = newSVuv(categories);
+    SV* flag_bit_sv = newSVuv(flag);
+
+    HV* msg_hv = newHV();
+
+    PERL_ARGS_ASSERT_NEW_MSG_HV;
+
+    hv_stores(msg_hv, "text", msg_sv);
+    hv_stores(msg_hv, "warn_categories",  category_sv);
+    hv_stores(msg_hv, "flag_bit", flag_bit_sv);
+
+    return msg_hv;
+}
+
 /*
 =for apidoc uvoffuni_to_utf8_flags
 
@@ -2142,22 +2165,15 @@ Perl_utf8n_to_uvchr_msgs(pTHX_ const U8 *s,
              * this iteration of the loop */
             if (message) {
                 if (msgs) {
-                    SV* msg_sv = newSVpv(message, 0);
-                    SV* category_sv = newSVuv(pack_warn);
-                    SV* flag_bit_sv = newSVuv(this_flag_bit);
-                    HV* msg_hv = newHV();
-
                     assert(this_flag_bit);
 
                     if (*msgs == NULL) {
                         *msgs = newAV();
                     }
 
-                    hv_stores(msg_hv, "text", msg_sv);
-                    hv_stores(msg_hv, "warn_categories",  category_sv);
-                    hv_stores(msg_hv, "flag_bit", flag_bit_sv);
-
-                    av_push(*msgs, newRV_noinc((SV*)msg_hv));
+                    av_push(*msgs, newRV_noinc((SV*) new_msg_hv(message,
+                                                                pack_warn,
+                                                                this_flag_bit)));
                 }
                 else if (PL_op)
                     Perl_warner(aTHX_ pack_warn, "%s in %s", message,