In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/d02d132368fb58f9c154375aed1d828614f7e42f?hp=e6ebbe921e63dbd445aa30e30a0b2b80574b88a0>
- Log ----------------------------------------------------------------- commit d02d132368fb58f9c154375aed1d828614f7e42f Author: Father Chrysostomos <[email protected]> Date: Wed Dec 3 22:07:39 2014 -0800 Deparse $x =~ (1?/$a/:0) under taint mode This code deparses incorrectly under taint mode: $ ./perl -Ilib -mO=Deparse -e '$x =~ (1?/$a/:0)' $x =~ ($_ =~ /$a/); -e syntax OK $ ./perl -Ilib -mO=Deparse -T -e '$x =~ (1?/$a/:0)' $x =~ /$a/; -e syntax OK The branch folding makes it deparse as â$x =~ /$a/â, whereas the /$a/ on the rhs, since it was not the argument to =~, is bound to $_, not to $x. Thatâs why B::Deparse adds the $_ =~, but it fails to do so under taint mode. It was broken by: commit 7fb31b92fa6bf56dff7d4240b7051b9158f7df43 Author: David Mitchell <[email protected]> Date: Sun Apr 1 10:21:22 2012 +0100 make OP_REGCRESET only for taint handling The OP_REGCRESET op, which is sometimes prepended to the chain of ops leading to OP_REGCOMP, currently serves two purposes; first to reset the taint flag, and second to initialise PL_reginterp_cnt. The second purpose is no longer needed, and the first has a bug, in that the op isn't prepended when "use re 'eval'" is in scope. Fix this by prepending the op solely when PL_tainting is in effect. This also makes run-time regexes slightly more efficient in the non-tainting case. which has a typo in it. ----------------------------------------------------------------------- Summary of changes: lib/B/Deparse.pm | 2 +- lib/B/Deparse.t | 7 ++++++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm index 07b986f..3d3fbcb 100644 --- a/lib/B/Deparse.pm +++ b/lib/B/Deparse.pm @@ -5216,7 +5216,7 @@ sub matchop { } if ($have_kid and $kid->name eq 'regcomp') { my $matchop = $kid->first; - if ($matchop->name eq 'regcrest') { + if ($matchop->name eq 'regcreset') { $matchop = $matchop->first; } if ($matchop->name =~ /^(?:match|transr?|subst)\z/ diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t index 02a3c6d..f354b9d 100644 --- a/lib/B/Deparse.t +++ b/lib/B/Deparse.t @@ -13,7 +13,7 @@ BEGIN { use warnings; use strict; -my $tests = 30; # not counting those in the __DATA__ section +my $tests = 31; # not counting those in the __DATA__ section use B::Deparse; my $deparse = B::Deparse->new(); @@ -406,6 +406,11 @@ like runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ], qr/^sub main::f \{/m, 'sub decl when lex sub is in scope'; +is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path, '-T' ], + prog => '$x =~ (1?/$a/:0)'), + '$x =~ ($_ =~ /$a/);'."\n", + '$foo =~ <branch-folded match> under taint mode'; + done_testing($tests); __DATA__ -- Perl5 Master Repository
