In perl.git, the branch sprout/overridesδ has been updated <http://perl5.git.perl.org/perl.git/commitdiff/e29ae51d573a96fe0ba35ebb5f97488dd482dd1f?hp=d92bbd13af6636360075728616b1d66a33adffd8>
- Log ----------------------------------------------------------------- commit e29ae51d573a96fe0ba35ebb5f97488dd482dd1f Author: Father Chrysostomos <[email protected]> Date: Mon May 14 13:19:38 2012 -0700 TODO tests for âifâ hiding âelseâ from keyword_plugin As discussed in ticket #108286, âelseâ and âelsifâ should be consid- ered part of the âifâ construct, rather than separate keywords, when parsed. The same applies to âcontinue {â after a loop. Currently PL_keyword_plugin is called for âelseâ after âifâ. M MANIFEST M ext/XS-APItest/APItest.pm M ext/XS-APItest/APItest.xs A ext/XS-APItest/t/keyword_else.t commit 22892818c4d77a0099d858091950b6a844fd756c Author: Father Chrysostomos <[email protected]> Date: Mon May 14 09:54:08 2012 -0700 Increase $XS::APItest::VERSION to 0.39 M ext/XS-APItest/APItest.pm ----------------------------------------------------------------------- Summary of changes: MANIFEST | 1 + ext/XS-APItest/APItest.pm | 8 +- ext/XS-APItest/APItest.xs | 28 ++++++ ext/XS-APItest/t/keyword_else.t | 198 +++++++++++++++++++++++++++++++++++++++ 4 files changed, 233 insertions(+), 2 deletions(-) create mode 100644 ext/XS-APItest/t/keyword_else.t diff --git a/MANIFEST b/MANIFEST index bd1c9a8..5e59327 100644 --- a/MANIFEST +++ b/MANIFEST @@ -3998,6 +3998,7 @@ ext/XS-APItest/t/gv_fetchmethod_flags.t XS::APItest: tests for gv_fetchmethod_fl ext/XS-APItest/t/gv_fetchmeth.t XS::APItest: tests for gv_fetchmeth() and variants ext/XS-APItest/t/gv_init.t XS::APItest: tests for gv_init and variants ext/XS-APItest/t/hash.t XS::APItest: tests for hash related APIs +ext/XS-APItest/t/keyword_else.t test keyword plugin w/ "else" & "continue" ext/XS-APItest/t/keyword_multiline.t test keyword plugin parsing across lines ext/XS-APItest/t/keyword_plugin.t test keyword plugin mechanism ext/XS-APItest/t/labelconst.aux auxiliary file for label test diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm index 6c3c323..3fb1c23 100644 --- a/ext/XS-APItest/APItest.pm +++ b/ext/XS-APItest/APItest.pm @@ -5,7 +5,7 @@ use strict; use warnings; use Carp; -our $VERSION = '0.38'; +our $VERSION = '0.39'; require XSLoader; @@ -40,7 +40,11 @@ sub import { } } foreach (keys %{$exports||{}}) { - next unless /\A(?:rpn|calcrpn|stufftest|swaptwostmts|looprest|scopelessblock|stmtasexpr|stmtsasexpr|loopblock|blockasexpr|swaplabel|labelconst|arrayfullexpr|arraylistexpr|arraytermexpr|arrayarithexp ... [21 chars truncated] + next unless + /\A(?:rpn|calcrpn|stufftest|swaptwostmts|looprest|scopelessblock + |stmtasexpr|stmtsasexpr|loopblock|blockasexpr|swaplabel + |labelconst|arrayfullexpr|arraylistexpr|arraytermexpr + |arrayarithexpr|arrayexprflags|els(?:e|if)|continue)\z/; $^H{"XS::APItest/$_"} = 1; delete $exports->{$_}; } diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index e2d34d9..afb2d61 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -656,6 +656,7 @@ static SV *hintkey_swaplabel_sv, *hintkey_labelconst_sv; static SV *hintkey_arrayfullexpr_sv, *hintkey_arraylistexpr_sv; static SV *hintkey_arraytermexpr_sv, *hintkey_arrayarithexpr_sv; static SV *hintkey_arrayexprflags_sv; +static SV *hintkey_else_sv, *hintkey_elsif_sv, *hintkey_continue_sv; static int (*next_keyword_plugin)(pTHX_ char *, STRLEN, OP **); /* low-level parser helpers */ @@ -941,6 +942,20 @@ static OP *THX_parse_keyword_arrayexprflags(pTHX) return o ? newANONLIST(o) : newANONHASH(newOP(OP_STUB, 0)); } +#define parse_elsif_parens() THX_parse_elsif_parens(aTHX) +static OP *THX_parse_elsif_parens(pTHX) +{ + OP *o; + lex_read_space(0); + if (lex_peek_unichar(0) != '(') croak("syntax error"); + lex_read_unichar(0); + o = parse_fullexpr(0); + lex_read_space(0); + if (lex_peek_unichar(0) != ')') croak("syntax error"); + lex_read_unichar(0); + return o; +} + /* plugin glue */ #define keyword_active(hintkey_sv) THX_keyword_active(aTHX_ hintkey_sv) @@ -1025,6 +1040,16 @@ static int my_keyword_plugin(pTHX_ keyword_active(hintkey_arrayexprflags_sv)) { *op_ptr = parse_keyword_arrayexprflags(); return KEYWORD_PLUGIN_EXPR; + } else if(( keyword_len == 4 && strnEQ(keyword_ptr, "else", 4) + && keyword_active(hintkey_else_sv)) + || ( keyword_len == 8 && strnEQ(keyword_ptr, "continue", 8) + && keyword_active(hintkey_continue_sv))) { + *op_ptr = newOP(OP_NULL, 0); + return KEYWORD_PLUGIN_STMT; + } else if(keyword_len == 5 && strnEQ(keyword_ptr, "elsif", 5) + && keyword_active(hintkey_elsif_sv)) { + *op_ptr = parse_elsif_parens(); + return KEYWORD_PLUGIN_STMT; } else { return next_keyword_plugin(aTHX_ keyword_ptr, keyword_len, op_ptr); } @@ -3173,6 +3198,9 @@ BOOT: hintkey_arraytermexpr_sv = newSVpvs_share("XS::APItest/arraytermexpr"); hintkey_arrayarithexpr_sv = newSVpvs_share("XS::APItest/arrayarithexpr"); hintkey_arrayexprflags_sv = newSVpvs_share("XS::APItest/arrayexprflags"); + hintkey_else_sv = newSVpvs_share("XS::APItest/else"); + hintkey_elsif_sv = newSVpvs_share("XS::APItest/elsif"); + hintkey_continue_sv = newSVpvs_share("XS::APItest/continue"); next_keyword_plugin = PL_keyword_plugin; PL_keyword_plugin = my_keyword_plugin; } diff --git a/ext/XS-APItest/t/keyword_else.t b/ext/XS-APItest/t/keyword_else.t new file mode 100644 index 0000000..f7b5fb6 --- /dev/null +++ b/ext/XS-APItest/t/keyword_else.t @@ -0,0 +1,198 @@ +use strict; + +use Test::More tests => 17; + +my $seen_else; +my $seen_elsif_expr; +my $seen_elsif; +my $seen_continue; + +sub _reset { + undef $_ + for $seen_else, $seen_elsif_expr, $seen_elsif, $seen_continue +} + +eval q{ + use XS::APItest (); + if (1) { } + else { $seen_else = 1 } +}; + +is $seen_else, undef, 'if swallows else with no keyword plugin'; + +_reset; +eval q{ + use XS::APItest 'else'; + if (1) { } + else { $seen_else = 1 } +}; + +{ + local $TODO = 'if does not yet hide else from keyword plugin'; + is $seen_else, undef, 'if swallows else with keyword plugin'; +} + +_reset; +eval q{ + use XS::APItest (); + if (1) { } + elsif ($seen_elsif_expr = 1) { $seen_elsif = 1 } +}; + +is_deeply [$seen_elsif_expr,$seen_elsif], [undef,undef], + 'if swallows elsif with no keyword plugin'; + +_reset; +eval q{ + use XS::APItest 'elsif'; + if (1) { } + elsif ($seen_elsif_expr = 1) { $seen_elsif = 1 } +}; + +{ + local $TODO = 'if does not yet hide elsif from keyword plugin'; + is_deeply [$seen_elsif_expr,$seen_elsif], [undef,undef], + 'if swallows elsif with keyword plugin'; +} + +_reset; +eval q{ + use XS::APItest (); + if (1) { } + elsif ($seen_elsif_expr = 1) { $seen_elsif = 1 } + else { $seen_else = 1 } +}; + +is_deeply [$seen_elsif_expr,$seen_elsif,$seen_else], [undef,undef,undef], + 'if swallows else and elsif with no keyword plugin'; + +_reset; +eval q{ + use XS::APItest 'elsif', 'else'; + if (1) { } + elsif ($seen_elsif_expr = 1) { $seen_elsif = 1 } + else { $seen_else = 1 } +}; + +{ + local $TODO = 'if does not yet hide else & elsif from keyword plugin'; + is_deeply [$seen_elsif_expr,$seen_elsif,$seen_else], + [undef,undef,undef], + 'if swallows else and elsif with keyword plugin'; +} + +_reset; +eval q{ + use XS::APItest (); + while(1) { last } + continue { $seen_continue = 1 } +}; + +is $seen_continue, undef, 'while swallows continue with no keyword plugin'; + +_reset; +eval q{ + use XS::APItest 'continue'; + while(1) { last } + continue { $seen_continue = 1 } +}; + +{ + local $TODO = 'while does not yet hide continue from keyword plugin'; + is $seen_continue, undef, + 'while swallows continue with keyword plugin'; +} + +_reset; +eval q{ + use XS::APItest (); + for(1) { last } + continue { $seen_continue = 1 } +}; + +is $seen_continue, undef, 'for swallows continue with no keyword plugin'; + +_reset; +eval q{ + use XS::APItest 'continue'; + for(1) { last } + continue { $seen_continue = 1 } +}; + +{ + local $TODO = 'for does not yet hide continue from keyword plugin'; + is $seen_continue, undef, 'for swallows continue with keyword plugin'; +} + +_reset; +eval q{ + use XS::APItest (); + foreach(1) { last } + continue { $seen_continue = 1 } +}; + +is $seen_continue, undef, + 'foreach swallows continue with no keyword plugin'; + +_reset; +eval q{ + use XS::APItest 'continue'; + foreach(1) { last } + continue { $seen_continue = 1 } +}; + +{ + local $TODO = 'foreach does not yet hide continue from keyword plugin'; + is $seen_continue, undef, + 'foreach swallows continue with keyword plugin'; +} + +_reset; +eval q{ + use XS::APItest 'continue'; + for(;;) { last } + continue { $seen_continue = 1 } +}; + +is $seen_continue, 1, 'for(;;) does not swallow continue'; + +_reset; +eval q{ + use XS::APItest 'continue'; + foreach(;;) { last } + continue { $seen_continue = 1 } +}; + +is $seen_continue, 1, 'foreach(;;) does not swallow continue'; + +_reset; +eval q{ + use XS::APItest (); + { last } + continue { $seen_continue = 1 } +}; + +is $seen_continue, undef, 'block swallows continue with no keyword plugin'; + +_reset; +eval q{ + use XS::APItest 'continue'; + { last } + continue { $seen_continue = 1 } +}; + +{ + local $TODO = 'block does not yet hide continue from keyword plugin'; + is $seen_continue, undef, + 'block swallows continue with keyword plugin'; +} + +_reset; +eval q{ + use XS::APItest 'continue'; + { last } + continue; # dies unless parsed by the keyword plugin + $seen_continue = 1; +}; + +is $seen_continue, 1, 'block does not swallow continue;'; -- Perl5 Master Repository
