chained comparisons

3 files changed, 87 insertions, 0 deletions

diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index d8a46206b6..c3d792712f 100644
--- a/lib/B/Deparse.pm
+++ b/lib/B/Deparse.pm
@@ -3200,6 +3200,64 @@ sub pp_andassign { logassignop(@_, "&&=") }
 sub pp_orassign  { logassignop(@_, "||=") }
 sub pp_dorassign { logassignop(@_, "//=") }
 
+my %cmpchain_cmpops = (
+	eq => ["==", 14],
+	i_eq => ["==", 14],
+	ne => ["!=", 14],
+	i_ne => ["!=", 14],
+	seq => ["eq", 14],
+	sne => ["ne", 14],
+	lt => ["<", 15],
+	i_lt => ["<", 15],
+	gt => [">", 15],
+	i_gt => [">", 15],
+	le => ["<=", 15],
+	i_le => ["<=", 15],
+	ge => [">=", 15],
+	i_ge => [">=", 15],
+	slt => ["lt", 15],
+	sgt => ["gt", 15],
+	sle => ["le", 15],
+	sge => ["ge", 15],
+);
+sub pp_cmpchain_and {
+    my($self, $op, $cx) = @_;
+    my($prec, $dep);
+    while(1) {
+	my($thiscmp, $rightcond);
+	if($op->name eq "cmpchain_and") {
+	    $thiscmp = $op->first;
+	    $rightcond = $thiscmp->sibling;
+	} else {
+	    $thiscmp = $op;
+	}
+	my $thiscmptype = $cmpchain_cmpops{$thiscmp->name} // (return "XXX");
+	if(defined $prec) {
+	    $thiscmptype->[1] == $prec or return "XXX";
+	    $thiscmp->first->name eq "null" &&
+		    !($thiscmp->first->flags & OPf_KIDS)
+		or return "XXX";
+	} else {
+	    $prec = $thiscmptype->[1];
+	    $dep = $self->deparse($thiscmp->first, $prec);
+	}
+	$dep .= " ".$thiscmptype->[0]." ";
+	my $operand = $thiscmp->last;
+	if(defined $rightcond) {
+	    $operand->name eq "cmpchain_dup" or return "XXX";
+	    $operand = $operand->first;
+	}
+	$dep .= $self->deparse($operand, $prec);
+	last unless defined $rightcond;
+	if($rightcond->name eq "null" && ($rightcond->flags & OPf_KIDS) &&
+		$rightcond->first->name eq "cmpchain_and") {
+	    $rightcond = $rightcond->first;
+	}
+	$op = $rightcond;
+    }
+    return $self->maybe_parens($dep, $cx, $prec);
+}
+
 sub rv2gv_or_string {
     my($self,$op) = @_;
     if ($op->name eq "gv") { # could be open("open") or open("###")
diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t
index e06ef6e966..4b7601d365 100644
--- a/lib/B/Deparse.t
+++ b/lib/B/Deparse.t
@@ -3092,3 +3092,30 @@ $r = $h->{'i'}{'j'}{'k'}{'l'}{'m'}{'n'}{'o'}{'p'}{'q'};
 $r = $h->{'i'}{'j'}{'k'}{'l'}{'m'}{'n'}{'o'}{'p'}{'q'}{'r'};
 $r = $h->{'i'}{'j'}{'k'}{'l'}{'m'}{'n'}{'o'}{'p'}{'q'}{'r'}{'s'};
 $r = $h->{'i'}{'j'}{'k'}{'l'}{'m'}{'n'}{'o'}{'p'}{'q'}{'r'}{'s'}{'t'};
+####
+# chained comparison
+my($a, $b, $c, $d, $e, $f, $g);
+$a = $b gt $c >= $d;
+$a = $b < $c <= $d > $e;
+$a = $b == $c != $d;
+$a = $b eq $c ne $d == $e;
+$a = $b << $c < $d << $e <= $f << $g;
+$a = int $b < int $c <= int $d;
+$a = ($b < $c) < ($d < $e) <= ($f < $g);
+$a = ($b == $c) < ($d == $e) <= ($f == $g);
+$a = ($b & $c) < ($d & $e) <= ($f & $g);
+$a = $b << $c == $d << $e != $f << $g;
+$a = int $b == int $c != int $d;
+$a = $b < $c == $d < $e != $f < $g;
+$a = ($b == $c) == ($d == $e) != ($f == $g);
+$a = ($b & $c) == ($d & $e) != ($f & $g);
+$a = $b << ($c < $d <= $e);
+$a = int($c < $d <= $e);
+$a = $b < ($c < $d <= $e);
+$a = $b == $c < $d <= $e;
+$a = $b & $c < $d <= $e;
+$a = $b << ($c == $d != $e);
+$a = int($c == $d != $e);
+$a = $b < ($c == $d != $e);
+$a = $b == ($c == $d != $e);
+$a = $b & $c == $d != $e;
diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm
index e24f217736..8cea633fdf 100644
--- a/lib/B/Op_private.pm
+++ b/lib/B/Op_private.pm
@@ -284,6 +284,8 @@ $bits{chr}{0} = $bf[0];
 $bits{chroot}{0} = $bf[0];
 @{$bits{close}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
 $bits{closedir}{0} = $bf[0];
+$bits{cmpchain_and}{0} = $bf[0];
+$bits{cmpchain_dup}{0} = $bf[0];
 $bits{complement}{0} = $bf[0];
 @{$bits{concat}}{6,1,0} = ('OPpCONCAT_NESTED', $bf[1], $bf[1]);
 $bits{cond_expr}{0} = $bf[0];