From: Nicholas Clark <nick@ccl4.org>
Date: Tue, 20 Oct 2009 08:48:38 +0000 (+0100)
Subject: Pull out filter setup code from S_swallow_bom() into S_add_utf16_textfilter()
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=81a923f452ade5c263d536ab9509f4be1fcd4e75;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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
--- 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
 
 /*