This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Let B::Deparse know about the [perl #20444] fix.
authorFather Chrysostomos <sprout@cpan.org>
Tue, 21 Sep 2010 05:05:39 +0000 (22:05 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Tue, 21 Sep 2010 05:05:39 +0000 (22:05 -0700)
With the previous commit:

$ ./perl -Ilib -MO=Deparse -e'"foo" =~ (1?/foo/:/bar/)'
'foo' =~ /foo/;
-e syntax OK

So the Deparse output no longer matches what perl does. With
this commit:

$ ./perl -Ilib -MO=Deparse -e'"foo" =~ (1?/foo/:/bar/)'
'foo' =~ ($_ =~ /foo/);
-e syntax OK

dist/B-Deparse/Deparse.pm
dist/B-Deparse/t/deparse.t

index f446f2a..92f2747 100644 (file)
@@ -4221,6 +4221,7 @@ sub matchop {
     }
     my $quote = 1;
     my $extended = ($op->pmflags & PMf_EXTENDED);
+    my $rhs_bound_to_defsv;
     if (null $kid) {
        my $unbacked = re_unback($op->precomp);
        if ($extended) {
@@ -4232,6 +4233,7 @@ sub matchop {
        carp("found ".$kid->name." where regcomp expected");
     } else {
        ($re, $quote) = $self->regcomp($kid, 21, $extended);
+       $rhs_bound_to_defsv = 1 if $kid->first->first->flags & OPf_SPECIAL;
     }
     my $flags = "";
     $flags .= "c" if $op->pmflags & PMf_CONTINUE;
@@ -4250,7 +4252,13 @@ sub matchop {
     }
     $re = $re . $flags if $quote;
     if ($binop) {
-       return $self->maybe_parens("$var =~ $re", $cx, 20);
+       return
+        $self->maybe_parens(
+         $rhs_bound_to_defsv
+          ? "$var =~ (\$_ =~ $re)"
+          : "$var =~ $re",
+         $cx, 20
+        );
     } else {
        return $re;
     }
index 3a7d2aa..0fc3b6c 100644 (file)
@@ -17,7 +17,7 @@ BEGIN {
     require feature;
     feature->import(':5.10');
 }
-use Test::More tests => 89;
+use Test::More tests => 90;
 use Config ();
 
 use B::Deparse;
@@ -645,3 +645,12 @@ pop;
 pop();
 ####
 pop @_;
+####
+# 82 [perl #20444]
+"foo" =~ (1 ? /foo/ : /bar/);
+"foo" =~ (1 ? y/foo// : /bar/);
+"foo" =~ (1 ? s/foo// : /bar/);
+>>>>
+'foo' =~ ($_ =~ /foo/);
+'foo' =~ ($_ =~ tr/fo//);
+'foo' =~ ($_ =~ s/foo//);