Pull out filter setup code from S_swallow_bom() into S_add_utf16_textfilter()

diff --git a/embed.fnc b/embed.fnc
index 9626427..0b0dd43 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1798,6 +1798,7 @@ sR        |char*  |skipspace      |NN char *s
 sR     |char*  |swallow_bom    |NN U8 *s
 #ifndef PERL_NO_UTF16_FILTER
 s      |I32    |utf16_textfilter|int idx|NN SV *sv|int maxlen
+s      |U8*    |add_utf16_textfilter|NN U8 *const s|bool reversed
 #endif
 s      |void   |checkcomma     |NN const char *s|NN const char *name \
                                |NN const char *what

diff --git a/embed.h b/embed.h
index 057c986..b3b655f 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1587,6 +1587,7 @@
 #ifndef PERL_NO_UTF16_FILTER
 #ifdef PERL_CORE
 #define utf16_textfilter       S_utf16_textfilter
+#define add_utf16_textfilter   S_add_utf16_textfilter
 #endif
 #endif
 #ifdef PERL_CORE
@@ -3964,6 +3965,7 @@
 #ifndef PERL_NO_UTF16_FILTER
 #ifdef PERL_CORE
 #define utf16_textfilter(a,b,c)        S_utf16_textfilter(aTHX_ a,b,c)
+#define add_utf16_textfilter(a,b)      S_add_utf16_textfilter(aTHX_ a,b)
 #endif
 #endif
 #ifdef PERL_CORE

diff --git a/proto.h b/proto.h
index b81d749..ca92cb9 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -5788,6 +5788,11 @@ STATIC I32       S_utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen)
 #define PERL_ARGS_ASSERT_UTF16_TEXTFILTER      \
        assert(sv)
 
+STATIC U8*     S_add_utf16_textfilter(pTHX_ U8 *const s, bool reversed)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_ADD_UTF16_TEXTFILTER  \
+       assert(s)
+
 #endif
 STATIC void    S_checkcomma(pTHX_ const char *s, const char *name, const char *what)
                        __attribute__nonnull__(pTHX_1)

diff --git a/toke.c b/toke.c
index 610cc24..dba9ae3 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -12703,21 +12703,8 @@ S_swallow_bom(pTHX_ U8 *s)
 #ifndef PERL_NO_UTF16_FILTER
            if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF16-LE script encoding (BOM)\n");
            s += 2;
-       utf16le:
            if (PL_bufend > (char*)s) {
-               U8 *news;
-               I32 newlen;
-
-               IoLINES(filter_add(S_utf16_textfilter, NULL)) = 1;
-               Newx(news, (PL_bufend - (char*)s) * 3 / 2 + 1, U8);
-               utf16_to_utf8_reversed(s, news,
-                                      PL_bufend - (char*)s - 1,
-                                      &newlen);
-               sv_setpvn(PL_linestr, (const char*)news, newlen);
-               Safefree(news);
-               SvUTF8_on(PL_linestr);
-               s = (U8*)SvPVX(PL_linestr);
-               PL_bufend = SvPVX(PL_linestr) + newlen;
+               s = add_utf16_textfilter(s, TRUE);
            }
 #else
            Perl_croak(aTHX_ "Unsupported script encoding UTF16-LE");
@@ -12729,21 +12716,8 @@ S_swallow_bom(pTHX_ U8 *s)
 #ifndef PERL_NO_UTF16_FILTER
            if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16BE script encoding (BOM)\n");
            s += 2;
-       utf16be:
            if (PL_bufend > (char *)s) {
-               U8 *news;
-               I32 newlen;
-
-               filter_add(S_utf16_textfilter, NULL);
-               Newx(news, (PL_bufend - (char*)s) * 3 / 2 + 1, U8);
-               utf16_to_utf8(s, news,
-                             PL_bufend - (char*)s,
-                             &newlen);
-               sv_setpvn(PL_linestr, (const char*)news, newlen);
-               Safefree(news);
-               SvUTF8_on(PL_linestr);
-               s = (U8*)SvPVX(PL_linestr);
-               PL_bufend = SvPVX(PL_linestr) + newlen;
+               s = add_utf16_textfilter(s, FALSE);
            }
 #else
            Perl_croak(aTHX_ "Unsupported script encoding UTF16-BE");
@@ -12769,7 +12743,7 @@ S_swallow_bom(pTHX_ U8 *s)
                   * 00 xx 00 xx
                   * are a good indicator of UTF-16BE. */
                  if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16BE script encoding (no BOM)\n");
-                 goto utf16be;
+               s = add_utf16_textfilter(s, FALSE);
             }
        }
 #ifdef EBCDIC
@@ -12787,7 +12761,7 @@ S_swallow_bom(pTHX_ U8 *s)
                   * xx 00 xx 00
                   * are a good indicator of UTF-16LE. */
              if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16LE script encoding (no BOM)\n");
-             goto utf16le;
+             s = add_utf16_textfilter(s, TRUE);
         }
     }
     return (char*)s;
@@ -12801,7 +12775,7 @@ S_utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen)
     dVAR;
     const STRLEN old = SvCUR(sv);
     const I32 count = FILTER_READ(idx+1, sv, maxlen);
-    const int reverse = IoLINES(sv);
+    const bool reverse = IoLINES(sv);
     DEBUG_P(PerlIO_printf(Perl_debug_log,
                          "utf16%s_textfilter(%p): %d %d (%d)\n",
                          reverse ? "rev" : "",
@@ -12828,6 +12802,26 @@ S_utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen)
     DEBUG_P({sv_dump(sv);});
     return SvCUR(sv);
 }
+
+static U8 *
+S_add_utf16_textfilter(pTHX_ U8 *const s, bool reversed)
+{
+    U8 *news;
+    I32 newlen;
+
+    IoLINES(filter_add(S_utf16_textfilter, NULL)) = reversed;
+    Newx(news, (PL_bufend - (char*)s) * 3 / 2 + 1, U8);
+    if (reversed) {
+       utf16_to_utf8_reversed(s, news, PL_bufend - (char*)s - 1, &newlen);
+    } else {
+       utf16_to_utf8(s, news, PL_bufend - (char*)s, &newlen);
+    }
+    sv_setpvn(PL_linestr, (const char*)news, newlen);
+    Safefree(news);
+    SvUTF8_on(PL_linestr);
+    PL_bufend = SvPVX(PL_linestr) + newlen;
+    return (U8*)SvPVX(PL_linestr);
+}
 #endif
 
 /*