In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/aa6dbd607b0a3d8a49c43b63b63b73ed167692c3?hp=28c3d5f4a254cce07b783305aa5f3a842a9aecbc>
- Log ----------------------------------------------------------------- commit aa6dbd607b0a3d8a49c43b63b63b73ed167692c3 Author: Nicholas Clark <[email protected]> Date: Sun Oct 18 17:47:10 2009 +0100 Merge S_utf16_textfilter and S_utf16rev_textfilter(). Use IoLINES() on the filter's SV to determine which encoding is in use. M embed.fnc M embed.h M proto.h M toke.c commit 161735889e3f206d41ba19c0a094a7e55e577462 Author: Nicholas Clark <[email protected]> Date: Sun Oct 18 17:10:02 2009 +0100 Note why S_pending_ident's prototype can't be generated by embed.fnc M toke.c commit a28af015d589214a604c671d2bc6eb78eba99218 Author: Nicholas Clark <[email protected]> Date: Sun Oct 18 17:06:55 2009 +0100 Generate prototypes for utf16_textfilter and utf16rev_textfilter using embed.fnc M embed.fnc M embed.h M proto.h M toke.c ----------------------------------------------------------------------- Summary of changes: embed.fnc | 3 +++ embed.h | 14 ++++++++++++++ proto.h | 7 +++++++ toke.c | 55 ++++++++++++++++++++----------------------------------- 4 files changed, 44 insertions(+), 35 deletions(-) diff --git a/embed.fnc b/embed.fnc index bb2a4d9..0fd0a41 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1793,6 +1793,9 @@ s |void |update_debugger_info|NULLOK SV *orig_sv \ |NULLOK const char *const buf|STRLEN len 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 +#endif s |void |checkcomma |NN const char *s|NN const char *name \ |NN const char *what s |bool |feature_is_enabled|NN const char *const name|STRLEN namelen diff --git a/embed.h b/embed.h index d896d79..66c3194 100644 --- a/embed.h +++ b/embed.h @@ -1580,6 +1580,13 @@ #define update_debugger_info S_update_debugger_info #define skipspace S_skipspace #define swallow_bom S_swallow_bom +#endif +#ifndef PERL_NO_UTF16_FILTER +#ifdef PERL_CORE +#define utf16_textfilter S_utf16_textfilter +#endif +#endif +#ifdef PERL_CORE #define checkcomma S_checkcomma #define feature_is_enabled S_feature_is_enabled #define force_ident S_force_ident @@ -3947,6 +3954,13 @@ #define update_debugger_info(a,b,c) S_update_debugger_info(aTHX_ a,b,c) #define skipspace(a) S_skipspace(aTHX_ a) #define swallow_bom(a) S_swallow_bom(aTHX_ a) +#endif +#ifndef PERL_NO_UTF16_FILTER +#ifdef PERL_CORE +#define utf16_textfilter(a,b,c) S_utf16_textfilter(aTHX_ a,b,c) +#endif +#endif +#ifdef PERL_CORE #define checkcomma(a,b,c) S_checkcomma(aTHX_ a,b,c) #define feature_is_enabled(a,b) S_feature_is_enabled(aTHX_ a,b) #define force_ident(a,b) S_force_ident(aTHX_ a,b) diff --git a/proto.h b/proto.h index 186bf40..7d47e9b 100644 --- a/proto.h +++ b/proto.h @@ -5764,6 +5764,13 @@ STATIC char* S_swallow_bom(pTHX_ U8 *s) #define PERL_ARGS_ASSERT_SWALLOW_BOM \ assert(s) +#ifndef PERL_NO_UTF16_FILTER +STATIC I32 S_utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen) + __attribute__nonnull__(pTHX_2); +#define PERL_ARGS_ASSERT_UTF16_TEXTFILTER \ + assert(sv) + +#endif STATIC void S_checkcomma(pTHX_ const char *s, const char *name, const char *what) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2) diff --git a/toke.c b/toke.c index 0b4ff5c..c7ec476 100644 --- a/toke.c +++ b/toke.c @@ -96,16 +96,13 @@ # define PL_nextval (PL_parser->nextval) #endif +/* This can't be done with embed.fnc, because struct yy_parser contains a + member named pending_ident, which clashes with the generated #define */ static int S_pending_ident(pTHX); static const char ident_too_long[] = "Identifier too long"; -#ifndef PERL_NO_UTF16_FILTER -static I32 utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen); -static I32 utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen); -#endif - #ifdef PERL_MAD # define CURMAD(slot,sv) if (PL_madskills) { curmad(slot,sv); sv = 0; } # define NEXTVAL_NEXTTOKE PL_nexttoke[PL_curforce].next_val @@ -12711,7 +12708,7 @@ S_swallow_bom(pTHX_ U8 *s) U8 *news; I32 newlen; - filter_add(utf16rev_textfilter, NULL); + 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, @@ -12746,7 +12743,7 @@ S_swallow_bom(pTHX_ U8 *s) U8 *news; I32 newlen; - filter_add(utf16_textfilter, NULL); + 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, @@ -12808,50 +12805,38 @@ S_swallow_bom(pTHX_ U8 *s) #ifndef PERL_NO_UTF16_FILTER static I32 -utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen) +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); DEBUG_P(PerlIO_printf(Perl_debug_log, - "utf16_textfilter(%p): %d %d (%d)\n", - FPTR2DPTR(void *, utf16_textfilter), + "utf16%s_textfilter(%p): %d %d (%d)\n", + reverse ? "rev" : "", + FPTR2DPTR(void *, S_utf16_textfilter), idx, maxlen, (int) count)); if (count) { U8* tmps; I32 newlen; Newx(tmps, SvCUR(sv) * 3 / 2 + 1, U8); Copy(SvPVX_const(sv), tmps, old, char); - utf16_to_utf8((U8*)SvPVX_const(sv) + old, tmps + old, - SvCUR(sv) - old, &newlen); + if (reverse) { + /* You would expect this to be utf16_to_utf8_reversed() + It was, prior to 1de9afcdf18cf98bbdecaa782da93e907be6fe4e + Effectively, right now, UTF-16LE is being read in off-by-one + See RT #69678 */ + utf16_to_utf8((U8*)SvPVX_const(sv) + old, tmps + old, + SvCUR(sv) - old, &newlen); + } else { + utf16_to_utf8((U8*)SvPVX_const(sv) + old, tmps + old, + SvCUR(sv) - old, &newlen); + } sv_usepvn(sv, (char*)tmps, (STRLEN)newlen + old); } DEBUG_P({sv_dump(sv);}); return SvCUR(sv); } - -static I32 -utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen) -{ - dVAR; - const STRLEN old = SvCUR(sv); - const I32 count = FILTER_READ(idx+1, sv, maxlen); - DEBUG_P(PerlIO_printf(Perl_debug_log, - "utf16rev_textfilter(%p): %d %d (%d)\n", - FPTR2DPTR(void *, utf16rev_textfilter), - idx, maxlen, (int) count)); - if (count) { - U8* tmps; - I32 newlen; - Newx(tmps, SvCUR(sv) * 3 / 2 + 1, U8); - Copy(SvPVX_const(sv), tmps, old, char); - utf16_to_utf8((U8*)SvPVX_const(sv) + old, tmps + old, - SvCUR(sv) - old, &newlen); - sv_usepvn(sv, (char*)tmps, (STRLEN)newlen + old); - } - DEBUG_P({ sv_dump(sv); }); - return count; -} #endif /* -- Perl5 Master Repository
