diff options
| author | Brian Fraser <fraserbn@gmail.com> | 2011-09-30 06:25:45 -0700 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2011-10-06 13:01:19 -0700 |
| commit | dab1c735364fcc41f4fbd1c15b5e26e8a7b07cab (patch) | |
| tree | a4681e32c95dbd9711ee77cbcbf3d0727dd84eee /toke.c | |
| parent | e0260a5b7a4c9245402af2910213dd35717e5bd2 (diff) | |
| download | perl-dab1c735364fcc41f4fbd1c15b5e26e8a7b07cab.tar.gz | |
toke.c, op.c, sv.c: Prototype parsing and checking are nul-and-UTF8 clean.
This means that eval "sub foo ($;\0whoops) { say @_ }" will correctly
include \0whoops in the CV's prototype (while complaining about illegal
characters), and that
use utf8;
BEGIN { $::{"foo"} = "\$\0L\351on" }
BEGIN { eval "sub foo (\$\0L\x{c3}\x{a9}on) {};"; }
will not warn about a mismatched prototype.
Diffstat (limited to 'toke.c')
| -rw-r--r-- | toke.c | 22 |
1 files changed, 14 insertions, 8 deletions
@@ -8024,21 +8024,22 @@ Perl_yylex(pTHX) bool underscore = FALSE; bool seen_underscore = FALSE; const bool warnillegalproto = ckWARN(WARN_ILLEGALPROTO); + STRLEN tmplen; s = scan_str(s,!!PL_madskills,FALSE); if (!s) Perl_croak(aTHX_ "Prototype not terminated"); /* strip spaces and check for bad characters */ - d = SvPVX(PL_lex_stuff); + d = SvPV(PL_lex_stuff, tmplen); tmp = 0; - for (p = d; *p; ++p) { + for (p = d; tmplen; tmplen--, ++p) { if (!isSPACE(*p)) { - d[tmp++] = *p; + d[tmp++] = *p; if (warnillegalproto) { if (must_be_last) proto_after_greedy_proto = TRUE; - if (!strchr("$@%*;[]&\\_+", *p)) { + if (!strchr("$@%*;[]&\\_+", *p) || *p == '\0') { bad_proto = TRUE; } else { @@ -8066,17 +8067,22 @@ Perl_yylex(pTHX) } } } - d[tmp] = '\0'; + d[tmp] = '\0'; if (proto_after_greedy_proto) Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO), "Prototype after '%c' for %"SVf" : %s", greedy_proto, SVfARG(PL_subname), d); - if (bad_proto) + if (bad_proto) { + SV *dsv = newSVpvs_flags("", SVs_TEMP); Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO), "Illegal character %sin prototype for %"SVf" : %s", seen_underscore ? "after '_' " : "", - SVfARG(PL_subname), d); - SvCUR_set(PL_lex_stuff, tmp); + SVfARG(PL_subname), + sv_uni_display(dsv, + newSVpvn_flags(d, tmp, SVs_TEMP | SvUTF8(PL_lex_stuff)), + tmp, UNI_DISPLAY_ISPRINT)); + } + SvCUR_set(PL_lex_stuff, tmp); have_proto = TRUE; #ifdef PERL_MAD |