mg.c: Extract code into a function.

This is in preparation for the same code to be used in additional
places.  There should be no logic changes.

4 files changed, 39 insertions, 18 deletions

diff --git a/embed.fnc b/embed.fnc
index 3d90eeb8c5..e98e95bf1c 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1829,6 +1829,7 @@ s	|SV*	|magic_methcall1|NN SV *sv|NN const MAGIC *mg \
 				|int n|NULLOK SV *val
 s	|void	|restore_magic	|NULLOK const void *p
 s	|void	|unwind_handler_stack|NULLOK const void *p
+s	|void	|fixup_errno_string|NN SV* sv
 
 #endif
 
diff --git a/embed.h b/embed.h
index c042eab45f..d25bb111b1 100644
--- a/embed.h
+++ b/embed.h
@@ -1421,6 +1421,7 @@
 #define adjust_size_and_find_bucket	S_adjust_size_and_find_bucket
 #  endif
 #  if defined(PERL_IN_MG_C)
+#define fixup_errno_string(a)	S_fixup_errno_string(aTHX_ a)
 #define magic_methcall1(a,b,c,d,e,f)	S_magic_methcall1(aTHX_ a,b,c,d,e,f)
 #define magic_methpack(a,b,c)	S_magic_methpack(aTHX_ a,b,c)
 #define restore_magic(a)	S_restore_magic(aTHX_ a)
diff --git a/mg.c b/mg.c
index eec2997a5f..ff827d1c09 100644
--- a/mg.c
+++ b/mg.c
@@ -739,6 +739,36 @@ Perl_emulate_cop_io(pTHX_ const COP *const c, SV *const sv)
     }
 }
 
+STATIC void
+S_fixup_errno_string(pTHX_ SV* sv)
+{
+    /* Do what is necessary to fixup the non-empty string in 'sv' for return to
+     * Perl space. */
+
+    PERL_ARGS_ASSERT_FIXUP_ERRNO_STRING;
+
+    assert(SvOK(sv));
+    assert(strNE(SvPVX(sv), ""));
+
+    /* In some locales the error string may come back as UTF-8, in
+     * which case we should turn on that flag.  This didn't use to
+     * happen, and to avoid any possible backward compatibility issues,
+     * we don't turn on the flag unless we have to.  So the flag stays
+     * off for an entirely ASCII string.  We assume that if the string
+     * looks like UTF-8, it really is UTF-8:  "text in any other
+     * encoding that uses bytes with the high bit set is extremely
+     * unlikely to pass a UTF-8 validity test"
+     * (http://en.wikipedia.org/wiki/Charset_detection).  There is a
+     * potential that we will get it wrong however, especially on short
+     * error message text.  (If it turns out to be necessary, we could
+     * also keep track if the current LC_MESSAGES locale is UTF-8) */
+    if (! is_ascii_string((U8*) SvPVX_const(sv), SvCUR(sv))
+        && is_utf8_string((U8*) SvPVX_const(sv), SvCUR(sv)))
+    {
+        SvUTF8_on(sv);
+    }
+}
+
 #ifdef VMS
 #include <descrip.h>
 #include <starlet.h>
@@ -860,24 +890,8 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
              * 'sv' not being considered SvOK.  The SvNOK_on() below will cause
              * just the number part to be valid */
             sv_setpv(sv, Strerror(errno));
-
-            /* In some locales the error string may come back as UTF-8, in
-             * which case we should turn on that flag.  This didn't use to
-             * happen, and to avoid any possible backward compatibility issues,
-             * we don't turn on the flag unless we have to.  So the flag stays
-             * off for an entirely ASCII string.  We assume that if the string
-             * looks like UTF-8, it really is UTF-8:  "text in any other
-             * encoding that uses bytes with the high bit set is extremely
-             * unlikely to pass a UTF-8 validity test"
-             * (http://en.wikipedia.org/wiki/Charset_detection).  There is a
-             * potential that we will get it wrong however, especially on short
-             * error message text.  (If it turns out to be necessary, we could
-             * also keep track if the current LC_MESSAGES locale is UTF-8) */
-            if (SvOK(sv)    /* It could be that Strerror returned invalid */
-                && ! is_ascii_string((U8*) SvPVX_const(sv), SvCUR(sv))
-                && is_utf8_string((U8*) SvPVX_const(sv), SvCUR(sv)))
-            {
-                SvUTF8_on(sv);
+            if (SvOK(sv)) {
+                fixup_errno_string(sv);
             }
         }
 	RESTORE_ERRNO;
diff --git a/proto.h b/proto.h
index 49b586d2dd..6b50e48033 100644
--- a/proto.h
+++ b/proto.h
@@ -5883,6 +5883,11 @@ STATIC int	S_adjust_size_and_find_bucket(size_t *nbytes_p)
 
 #endif
 #if defined(PERL_IN_MG_C)
+STATIC void	S_fixup_errno_string(pTHX_ SV* sv)
+			__attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_FIXUP_ERRNO_STRING	\
+	assert(sv)
+
 STATIC SV*	S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, SV *meth, U32 flags, int n, SV *val)
 			__attribute__nonnull__(pTHX_1)
 			__attribute__nonnull__(pTHX_2)