diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | op.c | 2 | ||||
| -rw-r--r-- | op.h | 1 | ||||
| -rw-r--r-- | parser.h | 2 | ||||
| -rw-r--r-- | pp_ctl.c | 4 | ||||
| -rw-r--r-- | t/uni/eval.t | 42 | ||||
| -rw-r--r-- | toke.c | 5 |
7 files changed, 54 insertions, 3 deletions
@@ -5333,6 +5333,7 @@ t/uni/case.pl See if Unicode casing works t/uni/chomp.t See if Unicode chomp works t/uni/chr.t See if Unicode chr works t/uni/class.t See if Unicode classes work (\p) +t/uni/eval.t See if Unicode hints don't affect eval() t/uni/fold.t See if Unicode folding works t/uni/goto.t See if Unicode goto &sub works t/uni/greek.t See if Unicode in greek works @@ -7484,6 +7484,8 @@ Perl_ck_eval(pTHX_ OP *o) MUTABLE_SV(hv_copy_hints_hv(GvHV(PL_hintgv)))); cUNOPo->op_first->op_sibling = hhop; o->op_private |= OPpEVAL_HAS_HH; + if (FEATURE_IS_ENABLED("unieval")) + o->op_private |= OPpEVAL_UNICODE; } return o; } @@ -295,6 +295,7 @@ Deprecated. Use C<GIMME_V> instead. /* Private for OP_ENTEREVAL */ #define OPpEVAL_HAS_HH 2 /* Does it have a copy of %^H */ +#define OPpEVAL_UNICODE 4 /* Private for OP_CALLER and OP_WANTARRAY */ #define OPpOFFBYONE 128 /* Treat caller(1) as caller(2) */ @@ -107,6 +107,7 @@ typedef struct yy_parser { bool in_pod; /* lexer is within a =pod section */ U8 lex_fakeeof; /* precedence at which to fake EOF */ + U32 lex_flags; } yy_parser; /* flags for lexer API */ @@ -118,6 +119,7 @@ typedef struct yy_parser { /* flags for parser API */ #define PARSE_OPTIONAL 0x00000001 +#define LEX_IGNORE_UTF8_HINTS 0x00000002 /* values for lex_fakeeof */ enum { @@ -4146,7 +4146,9 @@ PP(pp_entereval) TAINT_PROPER("eval"); ENTER_with_name("eval"); - lex_start(sv, NULL, LEX_START_SAME_FILTER); + lex_start(sv, NULL, LEX_START_SAME_FILTER | + ( PL_op->op_private & OPpEVAL_UNICODE + ? LEX_IGNORE_UTF8_HINTS : 0 )); SAVETMPS; /* switch to eval mode */ diff --git a/t/uni/eval.t b/t/uni/eval.t new file mode 100644 index 0000000000..f08c706cc7 --- /dev/null +++ b/t/uni/eval.t @@ -0,0 +1,42 @@ +#!./perl + +# Check if eval correctly ignores the UTF-8 hint. + +BEGIN { + require './test.pl'; +} + +plan (tests => 5); + +use open qw( :utf8 :std ); +use feature 'unicode_eval'; + +{ + my $w; + $SIG{__WARN__} = sub { $w = shift }; + use utf8; + my $prog = "qq!\x{f9}!"; + + eval $prog; + ok !$w; + + $w = ""; + utf8::upgrade($prog); + eval $prog; + is $w, ''; +} + +{ + use utf8; + isnt eval "q!\360\237\220\252!", eval "q!\x{1f42a}!"; +} + +{ + no utf8; #Let's make real sure. + my $not_utf8 = "q!\343\203\213!"; + isnt eval $not_utf8, eval "q!\x{30cb}!"; + { + use utf8; + isnt eval $not_utf8, eval "q!\x{30cb}!"; + } +} @@ -133,7 +133,7 @@ static const char ident_too_long[] = "Identifier too long"; #ifdef USE_UTF8_SCRIPTS # define UTF (!IN_BYTES) #else -# define UTF ((PL_linestr && DO_UTF8(PL_linestr)) || (PL_hints & HINT_UTF8)) +# define UTF ((PL_linestr && DO_UTF8(PL_linestr)) || ( !(PL_parser->lex_flags & LEX_IGNORE_UTF8_HINTS) && (PL_hints & HINT_UTF8))) #endif /* The maximum number of characters preceding the unrecognized one to display */ @@ -686,7 +686,7 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, U32 flags) const char *s = NULL; STRLEN len; yy_parser *parser, *oparser; - if (flags && flags != LEX_START_SAME_FILTER) + if (flags && flags & ~(LEX_START_SAME_FILTER|LEX_IGNORE_UTF8_HINTS)) Perl_croak(aTHX_ "Lexing code internal error (%s)", "lex_start"); /* create and initialise a parser */ @@ -743,6 +743,7 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, U32 flags) parser->linestart = SvPVX(parser->linestr); parser->bufend = parser->bufptr + SvCUR(parser->linestr); parser->last_lop = parser->last_uni = NULL; + parser->lex_flags = flags & LEX_IGNORE_UTF8_HINTS; parser->in_pod = 0; } |