{ OROP, TOKENTYPE_IVAL, "OROP" },
{ OROR, TOKENTYPE_NONE, "OROR" },
{ PACKAGE, TOKENTYPE_NONE, "PACKAGE" },
+ { PLUGEXPR, TOKENTYPE_OPVAL, "PLUGEXPR" },
+ { PLUGSTMT, TOKENTYPE_OPVAL, "PLUGSTMT" },
{ PMFUNC, TOKENTYPE_OPVAL, "PMFUNC" },
{ POSTDEC, TOKENTYPE_NONE, "POSTDEC" },
{ POSTINC, TOKENTYPE_NONE, "POSTINC" },
curoff = s - SvPVX(PL_linestr);
#endif
- if ((s = filter_gets(PL_linestr, PL_rsfp,
- (prevlen = SvCUR(PL_linestr)))) == NULL)
+ if ((s = filter_gets(PL_linestr, (prevlen = SvCUR(PL_linestr))))
+ == NULL)
{
#ifdef PERL_MAD
if (PL_madskills && curoff != startoff) {
}
STATIC char *
-S_filter_gets(pTHX_ register SV *sv, register PerlIO *fp, STRLEN append)
+S_filter_gets(pTHX_ register SV *sv, STRLEN append)
{
dVAR;
return NULL ;
}
else
- return (sv_gets(sv, fp, append));
+ return (sv_gets(sv, PL_rsfp, append));
}
STATIC HV *
}
do {
bof = PL_rsfp ? TRUE : FALSE;
- if ((s = filter_gets(PL_linestr, PL_rsfp, 0)) == NULL) {
+ if ((s = filter_gets(PL_linestr, 0)) == NULL) {
fake_eof:
#ifdef PERL_MAD
PL_realtokenstart = -1;
if (!PL_in_my || PL_lex_state != LEX_NORMAL)
break;
PL_bufptr = s; /* update in case we back off */
+ if (*s == '=') {
+ deprecate(":= for an empty attribute list");
+ }
goto grabattrs;
case XATTRBLOCK:
PL_expect = XBLOCK;
case 'z': case 'Z':
keylookup: {
+ bool anydelim;
I32 tmp;
orig_keyword = 0;
s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
/* Some keywords can be followed by any delimiter, including ':' */
- tmp = ((len == 1 && strchr("msyq", PL_tokenbuf[0])) ||
+ anydelim = ((len == 1 && strchr("msyq", PL_tokenbuf[0])) ||
(len == 2 && ((PL_tokenbuf[0] == 't' && PL_tokenbuf[1] == 'r') ||
(PL_tokenbuf[0] == 'q' &&
strchr("qwxr", PL_tokenbuf[1])))));
/* x::* is just a word, unless x is "CORE" */
- if (!tmp && *s == ':' && s[1] == ':' && strNE(PL_tokenbuf, "CORE"))
+ if (!anydelim && *s == ':' && s[1] == ':' && strNE(PL_tokenbuf, "CORE"))
goto just_a_word;
d = s;
while (d < PL_bufend && isSPACE(*d))
d++; /* no comments skipped here, or s### is misparsed */
- /* Is this a label? */
- if (!tmp && PL_expect == XSTATE
- && d < PL_bufend && *d == ':' && *(d + 1) != ':') {
- tmp = keyword(PL_tokenbuf, len, 0);
- if (tmp)
- Perl_croak(aTHX_ "Can't use keyword '%s' as a label", PL_tokenbuf);
- s = d + 1;
- pl_yylval.pval = CopLABEL_alloc(PL_tokenbuf);
- CLINE;
- TOKEN(LABEL);
- }
- else
- /* Check for keywords */
- tmp = keyword(PL_tokenbuf, len, 0);
-
/* Is this a word before a => operator? */
if (*d == '=' && d[1] == '>') {
CLINE;
TERM(WORD);
}
+ /* Check for plugged-in keyword */
+ {
+ OP *o;
+ int result;
+ char *saved_bufptr = PL_bufptr;
+ PL_bufptr = s;
+ result = CALL_FPTR(PL_keyword_plugin)(aTHX_ PL_tokenbuf, len, &o);
+ s = PL_bufptr;
+ if (result == KEYWORD_PLUGIN_DECLINE) {
+ /* not a plugged-in keyword */
+ PL_bufptr = saved_bufptr;
+ } else if (result == KEYWORD_PLUGIN_STMT) {
+ pl_yylval.opval = o;
+ CLINE;
+ PL_expect = XSTATE;
+ return REPORT(PLUGSTMT);
+ } else if (result == KEYWORD_PLUGIN_EXPR) {
+ pl_yylval.opval = o;
+ CLINE;
+ PL_expect = XOPERATOR;
+ return REPORT(PLUGEXPR);
+ } else {
+ Perl_croak(aTHX_ "Bad plugin affecting keyword '%s'",
+ PL_tokenbuf);
+ }
+ }
+
+ /* Check for built-in keyword */
+ tmp = keyword(PL_tokenbuf, len, 0);
+
+ /* Is this a label? */
+ if (!anydelim && PL_expect == XSTATE
+ && d < PL_bufend && *d == ':' && *(d + 1) != ':') {
+ if (tmp)
+ Perl_croak(aTHX_ "Can't use keyword '%s' as a label", PL_tokenbuf);
+ s = d + 1;
+ pl_yylval.pval = CopLABEL_alloc(PL_tokenbuf);
+ CLINE;
+ TOKEN(LABEL);
+ }
+
if (tmp < 0) { /* second-class keyword? */
GV *ogv = NULL; /* override (winner) */
GV *hgv = NULL; /* hidden (loser) */
SV *sv;
int pkgname = 0;
const char lastchar = (PL_bufptr == PL_oldoldbufptr ? 0 : PL_bufptr[-1]);
+ OP *rv2cv_op;
CV *cv;
#ifdef PERL_MAD
SV *nextPL_nextwhite = 0;
if (len)
goto safe_bareword;
- /* Do the explicit type check so that we don't need to force
- the initialisation of the symbol table to have a real GV.
- Beware - gv may not really be a PVGV, cv may not really be
- a PVCV, (because of the space optimisations that gv_init
- understands) But they're true if for this symbol there is
- respectively a typeglob and a subroutine.
- */
- cv = gv ? ((SvTYPE(gv) == SVt_PVGV)
- /* Real typeglob, so get the real subroutine: */
- ? GvCVu(gv)
- /* A proxy for a subroutine in this package? */
- : SvOK(gv) ? MUTABLE_CV(gv) : NULL)
- : NULL;
+ cv = NULL;
+ {
+ OP *const_op = newSVOP(OP_CONST, 0, SvREFCNT_inc(sv));
+ const_op->op_private = OPpCONST_BARE;
+ rv2cv_op = newCVREF(0, const_op);
+ }
+ if (rv2cv_op->op_type == OP_RV2CV &&
+ (rv2cv_op->op_flags & OPf_KIDS)) {
+ OP *rv_op = cUNOPx(rv2cv_op)->op_first;
+ switch (rv_op->op_type) {
+ case OP_CONST: {
+ SV *sv = cSVOPx_sv(rv_op);
+ if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV)
+ cv = (CV*)SvRV(sv);
+ } break;
+ case OP_GV: {
+ GV *gv = cGVOPx_gv(rv_op);
+ CV *maybe_cv = GvCVu(gv);
+ if (maybe_cv && SvTYPE((SV*)maybe_cv) == SVt_PVCV)
+ cv = maybe_cv;
+ } break;
+ }
+ }
/* See if it's the indirect object for a list operator. */
/* Two barewords in a row may indicate method call. */
if ((isIDFIRST_lazy_if(s,UTF) || *s == '$') &&
- (tmp = intuit_method(s, gv, cv)))
+ (tmp = intuit_method(s, gv, cv))) {
+ op_free(rv2cv_op);
return REPORT(tmp);
+ }
/* If not a declared subroutine, it's an indirect object. */
/* (But it's an indir obj regardless for sort.) */
if (
( !immediate_paren && (PL_last_lop_op == OP_SORT ||
- ((!gv || !cv) &&
+ (!cv &&
(PL_last_lop_op != OP_MAPSTART &&
PL_last_lop_op != OP_GREPSTART))))
|| (PL_tokenbuf[0] == '_' && PL_tokenbuf[1] == '\0'
/* Is this a word before a => operator? */
if (*s == '=' && s[1] == '>' && !pkgname) {
+ op_free(rv2cv_op);
CLINE;
sv_setpv(((SVOP*)pl_yylval.opval)->op_sv, PL_tokenbuf);
if (UTF && !IN_BYTES && is_utf8_string((U8*)PL_tokenbuf, len))
d = s + 1;
while (SPACE_OR_TAB(*d))
d++;
- if (*d == ')' && (sv = gv_const_sv(gv))) {
+ if (*d == ')' && (sv = cv_const_sv(cv))) {
s = d + 1;
goto its_constant;
}
PL_thistoken = newSVpvs("");
}
#endif
+ op_free(rv2cv_op);
force_next(WORD);
pl_yylval.ival = 0;
TOKEN('&');
/* If followed by var or block, call it a method (unless sub) */
- if ((*s == '$' || *s == '{') && (!gv || !cv)) {
+ if ((*s == '$' || *s == '{') && !cv) {
+ op_free(rv2cv_op);
PL_last_lop = PL_oldbufptr;
PL_last_lop_op = OP_METHOD;
PREBLOCK(METHOD);
if (!orig_keyword
&& (isIDFIRST_lazy_if(s,UTF) || *s == '$')
- && (tmp = intuit_method(s, gv, cv)))
+ && (tmp = intuit_method(s, gv, cv))) {
+ op_free(rv2cv_op);
return REPORT(tmp);
+ }
/* Not a method, so call it a subroutine (if defined) */
"Ambiguous use of -%s resolved as -&%s()",
PL_tokenbuf, PL_tokenbuf);
/* Check for a constant sub */
- if ((sv = gv_const_sv(gv))) {
+ if ((sv = cv_const_sv(cv))) {
its_constant:
+ op_free(rv2cv_op);
SvREFCNT_dec(((SVOP*)pl_yylval.opval)->op_sv);
((SVOP*)pl_yylval.opval)->op_sv = SvREFCNT_inc_simple(sv);
pl_yylval.opval->op_private = 0;
TOKEN(WORD);
}
- /* Resolve to GV now. */
- if (SvTYPE(gv) != SVt_PVGV) {
- gv = gv_fetchpv(PL_tokenbuf, 0, SVt_PVCV);
- assert (SvTYPE(gv) == SVt_PVGV);
- /* cv must have been some sort of placeholder, so
- now needs replacing with a real code reference. */
- cv = GvCV(gv);
- }
-
op_free(pl_yylval.opval);
- pl_yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
+ pl_yylval.opval = rv2cv_op;
pl_yylval.opval->op_private |= OPpENTERSUB_NOPAREN;
PL_last_lop = PL_oldbufptr;
PL_last_lop_op = OP_ENTERSUB;
if (probable_sub) {
gv = gv_fetchpv(PL_tokenbuf, GV_ADD, SVt_PVCV);
op_free(pl_yylval.opval);
- pl_yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
+ pl_yylval.opval = rv2cv_op;
pl_yylval.opval->op_private |= OPpENTERSUB_NOPAREN;
PL_last_lop = PL_oldbufptr;
PL_last_lop_op = OP_ENTERSUB;
}
}
}
+ op_free(rv2cv_op);
safe_bareword:
if ((lastchar == '*' || lastchar == '%' || lastchar == '&')) {
sv_catpvn(PL_endwhite, tstart, PL_bufend - tstart);
PL_realtokenstart = -1;
}
- while ((s = filter_gets(PL_endwhite, PL_rsfp,
- SvCUR(PL_endwhite))) != NULL) ;
+ while ((s = filter_gets(PL_endwhite, SvCUR(PL_endwhite)))
+ != NULL) ;
}
#endif
PL_rsfp = NULL;
yyerror(Perl_form(aTHX_ "No package name allowed for "
"variable %s in \"our\"",
PL_tokenbuf));
- tmp = allocmy(PL_tokenbuf);
+ tmp = allocmy(PL_tokenbuf, tokenbuf_len, 0);
}
else {
if (has_colon)
PL_in_my == KEY_my ? "my" : "state", PL_tokenbuf));
pl_yylval.opval = newOP(OP_PADANY, 0);
- pl_yylval.opval->op_targ = allocmy(PL_tokenbuf);
+ pl_yylval.opval->op_targ = allocmy(PL_tokenbuf, tokenbuf_len, 0);
return PRIVATEREF;
}
}
if (!has_colon) {
if (!PL_in_my)
- tmp = pad_findmy(PL_tokenbuf);
+ tmp = pad_findmy(PL_tokenbuf, tokenbuf_len, 0);
if (tmp != NOT_IN_PAD) {
/* might be an "our" variable" */
if (PAD_COMPNAME_FLAGS_isOUR(tmp)) {
and @foo isn't a variable we can find in the symbol
table.
*/
- if (pit == '@' && PL_lex_state != LEX_NORMAL && !PL_lex_brackets) {
+ if (ckWARN(WARN_AMBIGUOUS) &&
+ pit == '@' && PL_lex_state != LEX_NORMAL && !PL_lex_brackets) {
GV *const gv = gv_fetchpvn_flags(PL_tokenbuf + 1, tokenbuf_len - 1, 0,
SVt_PVAV);
if ((!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv)))
)
{
/* Downgraded from fatal to warning 20000522 mjd */
- Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
- "Possible unintended interpolation of %s in string",
- PL_tokenbuf);
+ Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
+ "Possible unintended interpolation of %s in string",
+ PL_tokenbuf);
}
}
return s;
}
+static U32
+S_pmflag(U32 pmfl, const char ch) {
+ switch (ch) {
+ CASE_STD_PMMOD_FLAGS_PARSE_SET(&pmfl);
+ case GLOBAL_PAT_MOD: pmfl |= PMf_GLOBAL; break;
+ case CONTINUE_PAT_MOD: pmfl |= PMf_CONTINUE; break;
+ case ONCE_PAT_MOD: pmfl |= PMf_KEEP; break;
+ case KEEPCOPY_PAT_MOD: pmfl |= PMf_KEEPCOPY; break;
+ }
+ return pmfl;
+}
+
void
Perl_pmflag(pTHX_ U32* pmfl, int ch)
{
PERL_ARGS_ASSERT_PMFLAG;
- PERL_UNUSED_CONTEXT;
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
+ "Perl_pmflag() is deprecated, and will be removed from the XS API");
+
if (ch<256) {
- const char c = (char)ch;
- switch (c) {
- CASE_STD_PMMOD_FLAGS_PARSE_SET(pmfl);
- case GLOBAL_PAT_MOD: *pmfl |= PMf_GLOBAL; break;
- case CONTINUE_PAT_MOD: *pmfl |= PMf_CONTINUE; break;
- case ONCE_PAT_MOD: *pmfl |= PMf_KEEP; break;
- case KEEPCOPY_PAT_MOD: *pmfl |= PMf_KEEPCOPY; break;
- }
+ *pmfl = S_pmflag(*pmfl, (char)ch);
}
}
modstart = s;
#endif
while (*s && strchr(valid_flags, *s))
- pmflag(&pm->op_pmflags,*s++);
+ pm->op_pmflags = S_pmflag(pm->op_pmflags, *s++);
#ifdef PERL_MAD
if (PL_madskills && modstart != s) {
SV* tmptoken = newSVpvn(modstart, s - modstart);
es++;
}
else if (strchr(S_PAT_MODS, *s))
- pmflag(&pm->op_pmflags,*s++);
+ pm->op_pmflags = S_pmflag(pm->op_pmflags, *s++);
else
break;
}
}
#endif
if (!outer ||
- !(PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = filter_gets(PL_linestr, PL_rsfp, 0))) {
+ !(PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart
+ = filter_gets(PL_linestr, 0))) {
CopLINE_set(PL_curcop, (line_t)PL_multi_start);
missingterm(PL_tokenbuf);
}
/* try to find it in the pad for this block, otherwise find
add symbol table ops
*/
- const PADOFFSET tmp = pad_findmy(d);
+ const PADOFFSET tmp = pad_findmy(d, len, 0);
if (tmp != NOT_IN_PAD) {
if (PAD_COMPNAME_FLAGS_isOUR(tmp)) {
HV * const stash = PAD_COMPNAME_OURSTASH(tmp);
}
#endif
if (!PL_rsfp ||
- !(PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = filter_gets(PL_linestr, PL_rsfp, 0))) {
+ !(PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart
+ = filter_gets(PL_linestr, 0))) {
sv_free(sv);
CopLINE_set(PL_curcop, (line_t)PL_multi_start);
return NULL;
PL_thistoken = newSVpvn(tokenstart, PL_bufend - tokenstart);
}
#endif
- s = filter_gets(PL_linestr, PL_rsfp, 0);
+ s = filter_gets(PL_linestr, 0);
#ifdef PERL_MAD
tokenstart = PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr);
#else
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 bool reverse = IoLINES(sv);
+ SV *const filter = FILTER_DATA(idx);
+ /* We re-use this each time round, throwing the contents away before we
+ return. */
+ SV *const utf16_buffer = MUTABLE_SV(IoTOP_GV(filter));
+ SV *const utf8_buffer = filter;
+ IV status = IoPAGE(filter);
+ const bool reverse = (bool) IoLINES(filter);
+ I32 retval;
+
+ /* As we're automatically added, at the lowest level, and hence only called
+ from this file, we can be sure that we're not called in block mode. Hence
+ don't bother writing code to deal with block mode. */
+ if (maxlen) {
+ Perl_croak(aTHX_ "panic: utf16_textfilter called in block mode (for %d characters)", maxlen);
+ }
+ if (status < 0) {
+ Perl_croak(aTHX_ "panic: utf16_textfilter called after error (status=%"IVdf")", status);
+ }
DEBUG_P(PerlIO_printf(Perl_debug_log,
- "utf16%s_textfilter(%p): %d %d (%d)\n",
- reverse ? "rev" : "",
+ "utf16_textfilter(%p,%ce): idx=%d maxlen=%d status=%"IVdf" utf16=%"UVuf" utf8=%"UVuf"\n",
FPTR2DPTR(void *, S_utf16_textfilter),
- idx, maxlen, (int) count));
- if (count) {
- U8* tmps;
+ reverse ? 'l' : 'b', idx, maxlen, status,
+ (UV)SvCUR(utf16_buffer), (UV)SvCUR(utf8_buffer)));
+
+ while (1) {
+ STRLEN chars;
+ STRLEN have;
I32 newlen;
- Newx(tmps, SvCUR(sv) * 3 / 2 + 1, U8);
- Copy(SvPVX_const(sv), tmps, old, char);
+ U8 *end;
+ /* First, look in our buffer of existing UTF-8 data: */
+ char *nl = (char *)memchr(SvPVX(utf8_buffer), '\n', SvCUR(utf8_buffer));
+
+ if (nl) {
+ ++nl;
+ } else if (status == 0) {
+ /* EOF */
+ IoPAGE(filter) = 0;
+ nl = SvEND(utf8_buffer);
+ }
+ if (nl) {
+ STRLEN got = nl - SvPVX(utf8_buffer);
+ /* Did we have anything to append? */
+ retval = got != 0;
+ sv_catpvn(sv, SvPVX(utf8_buffer), got);
+ /* Everything else in this code works just fine if SVp_POK isn't
+ set. This, however, needs it, and we need it to work, else
+ we loop infinitely because the buffer is never consumed. */
+ sv_chop(utf8_buffer, nl);
+ break;
+ }
+
+ /* OK, not a complete line there, so need to read some more UTF-16.
+ Read an extra octect if the buffer currently has an odd number. */
+ while (1) {
+ if (status <= 0)
+ break;
+ if (SvCUR(utf16_buffer) >= 2) {
+ /* Location of the high octet of the last complete code point.
+ Gosh, UTF-16 is a pain. All the benefits of variable length,
+ *coupled* with all the benefits of partial reads and
+ endianness. */
+ const U8 *const last_hi = (U8*)SvPVX(utf16_buffer)
+ + ((SvCUR(utf16_buffer) & ~1) - (reverse ? 1 : 2));
+
+ if (*last_hi < 0xd8 || *last_hi > 0xdb) {
+ break;
+ }
+
+ /* We have the first half of a surrogate. Read more. */
+ DEBUG_P(PerlIO_printf(Perl_debug_log, "utf16_textfilter partial surrogate detected at %p\n", last_hi));
+ }
+
+ status = FILTER_READ(idx + 1, utf16_buffer,
+ 160 + (SvCUR(utf16_buffer) & 1));
+ DEBUG_P(PerlIO_printf(Perl_debug_log, "utf16_textfilter status=%"IVdf" SvCUR(sv)=%"UVuf"\n", status, (UV)SvCUR(utf16_buffer)));
+ DEBUG_P({ sv_dump(utf16_buffer); sv_dump(utf8_buffer);});
+ if (status < 0) {
+ /* Error */
+ IoPAGE(filter) = status;
+ return status;
+ }
+ }
+
+ chars = SvCUR(utf16_buffer) >> 1;
+ have = SvCUR(utf8_buffer);
+ SvGROW(utf8_buffer, have + chars * 3 + 1);
+
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);
+ end = utf16_to_utf8_reversed((U8*)SvPVX(utf16_buffer),
+ (U8*)SvPVX_const(utf8_buffer) + have,
+ chars * 2, &newlen);
} else {
- utf16_to_utf8((U8*)SvPVX_const(sv) + old, tmps + old,
- SvCUR(sv) - old, &newlen);
+ end = utf16_to_utf8((U8*)SvPVX(utf16_buffer),
+ (U8*)SvPVX_const(utf8_buffer) + have,
+ chars * 2, &newlen);
+ }
+ SvCUR_set(utf8_buffer, have + newlen);
+ *end = '\0';
+
+ /* No need to keep this SV "well-formed" with a '\0' after the end, as
+ it's private to us, and utf16_to_utf8{,reversed} take a
+ (pointer,length) pair, rather than a NUL-terminated string. */
+ if(SvCUR(utf16_buffer) & 1) {
+ *SvPVX(utf16_buffer) = SvEND(utf16_buffer)[-1];
+ SvCUR_set(utf16_buffer, 1);
+ } else {
+ SvCUR_set(utf16_buffer, 0);
}
- sv_usepvn(sv, (char*)tmps, (STRLEN)newlen + old);
}
- DEBUG_P({sv_dump(sv);});
- return SvCUR(sv);
+ DEBUG_P(PerlIO_printf(Perl_debug_log,
+ "utf16_textfilter: returns, status=%"IVdf" utf16=%"UVuf" utf8=%"UVuf"\n",
+ status,
+ (UV)SvCUR(utf16_buffer), (UV)SvCUR(utf8_buffer)));
+ DEBUG_P({ sv_dump(utf8_buffer); sv_dump(sv);});
+ return retval;
}
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);
+ SV *filter = filter_add(S_utf16_textfilter, NULL);
+
+ IoTOP_GV(filter) = MUTABLE_GV(newSVpvn((char *)s, PL_bufend - (char*)s));
+ sv_setpvs(filter, "");
+ IoLINES(filter) = reversed;
+ IoPAGE(filter) = 1; /* Not EOF */
+
+ /* Sadly, we have to return a valid pointer, come what may, so we have to
+ ignore any error return from this. */
+ SvCUR_set(PL_linestr, 0);
+ if (FILTER_READ(0, PL_linestr, 0)) {
+ SvUTF8_on(PL_linestr);
} else {
- utf16_to_utf8(s, news, PL_bufend - (char*)s, &newlen);
+ SvUTF8_on(PL_linestr);
}
- sv_setpvn(PL_linestr, (const char*)news, newlen);
- Safefree(news);
- SvUTF8_on(PL_linestr);
- PL_bufend = SvPVX(PL_linestr) + newlen;
+ PL_bufend = SvEND(PL_linestr);
return (U8*)SvPVX(PL_linestr);
}
#endif
return (char *)s;
}
+int
+Perl_keyword_plugin_standard(pTHX_
+ char *keyword_ptr, STRLEN keyword_len, OP **op_ptr)
+{
+ PERL_ARGS_ASSERT_KEYWORD_PLUGIN_STANDARD;
+ PERL_UNUSED_CONTEXT;
+ PERL_UNUSED_ARG(keyword_ptr);
+ PERL_UNUSED_ARG(keyword_len);
+ PERL_UNUSED_ARG(op_ptr);
+ return KEYWORD_PLUGIN_DECLINE;
+}
+
/*
* Local variables:
* c-indentation-style: bsd