t/op/cmpchain.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     require "./test.pl";
   6     set_up_inc("../lib");
   7 }
   8
   9 use feature "isa";
  10 no warnings qw(experimental::smartmatch experimental::isa);
  11
  12 my @cheqop = qw(== != eq ne);
  13 my @nceqop = qw(<=> cmp ~~);
  14 my @chrelop = qw(< > <= >= lt gt le ge);
  15 my @ncrelop = qw(isa);
  16
  17 plan tests => @nceqop*@nceqop + 2*@cheqop*@nceqop + 2*@cheqop*@cheqop*@nceqop +
  18         @ncrelop*@ncrelop + 2*@chrelop*@ncrelop + 2*@chrelop*@chrelop*@ncrelop +
  19
  20         @cheqop*@cheqop + @chrelop*@chrelop +
  21         @cheqop*@cheqop*@cheqop + @chrelop*@chrelop*@chrelop +
  22         (9 + 6*9)*13;
  23
  24 foreach my $c0 (@nceqop) {
  25     foreach my $c1 (@nceqop) {
  26         is eval("sub { \$a $c0 \$b $c1 \$c }"), undef,
  27             "$c0 $c1 non-associative";
  28     }
  29 }
  30 foreach my $c (@nceqop) {
  31     foreach my $e (@cheqop) {
  32         is eval("sub { \$a $c \$b $e \$c }"), undef, "$c $e non-associative";
  33         is eval("sub { \$a $e \$b $c \$c }"), undef, "$e $c non-associative";
  34     }
  35 }
  36 foreach my $c (@nceqop) {
  37     foreach my $e0 (@cheqop) {
  38         foreach my $e1 (@cheqop) {
  39             is eval("sub { \$a $c \$b $e0 \$c $e1 \$d }"), undef,
  40                 "$c $e0 $e1 non-associative";
  41             is eval("sub { \$a $e0 \$b $e1 \$c $c \$d }"), undef,
  42                 "$e0 $e1 $c non-associative";
  43         }
  44     }
  45 }
  46
  47 foreach my $c0 (@ncrelop) {
  48     foreach my $c1 (@ncrelop) {
  49         is eval("sub { \$a $c0 \$b $c1 \$c }"), undef,
  50             "$c0 $c1 non-associative";
  51     }
  52 }
  53 foreach my $c (@ncrelop) {
  54     foreach my $e (@chrelop) {
  55         is eval("sub { \$a $c \$b $e \$c }"), undef, "$c $e non-associative";
  56         is eval("sub { \$a $e \$b $c \$c }"), undef, "$e $c non-associative";
  57     }
  58 }
  59 foreach my $c (@ncrelop) {
  60     foreach my $e0 (@chrelop) {
  61         foreach my $e1 (@chrelop) {
  62             is eval("sub { \$a $c \$b $e0 \$c $e1 \$d }"), undef,
  63                 "$c $e0 $e1 non-associative";
  64             is eval("sub { \$a $e0 \$b $e1 \$c $c \$d }"), undef,
  65                 "$e0 $e1 $c non-associative";
  66         }
  67     }
  68 }
  69
  70 foreach my $e0 (@cheqop) {
  71     foreach my $e1 (@cheqop) {
  72         isnt eval("sub { \$a $e0 \$b $e1 \$c }"), undef, "$e0 $e1 legal";
  73     }
  74 }
  75 foreach my $r0 (@chrelop) {
  76     foreach my $r1 (@chrelop) {
  77         isnt eval("sub { \$a $r0 \$b $r1 \$c }"), undef, "$r0 $r1 legal";
  78     }
  79 }
  80 foreach my $e0 (@cheqop) {
  81     foreach my $e1 (@cheqop) {
  82         foreach my $e2 (@cheqop) {
  83             isnt eval("sub { \$a $e0 \$b $e1 \$c $e2 \$d }"), undef,
  84                 "$e0 $e1 $e2 legal";
  85         }
  86     }
  87 }
  88 foreach my $r0 (@chrelop) {
  89     foreach my $r1 (@chrelop) {
  90         foreach my $r2 (@chrelop) {
  91             isnt eval("sub { \$a $r0 \$b $r1 \$c $r2 \$d }"), undef,
  92                 "$r0 $r1 $r2 legal";
  93         }
  94     }
  95 }
  96
  97 foreach(
  98     [5,3,2], [5,3,3], [5,3,4], [5,3,5], [5,3,6],
  99     [5,5,4], [5,5,5], [5,5,6],
 100     [5,7,4], [5,7,5], [5,7,6], [5,7,7], [5,7,8],
 101 ) {
 102     is join(",", "x", $_->[0] == $_->[1] != $_->[2], "y"),
 103         join(",", "x", !!($_->[0] == $_->[1] && $_->[1] != $_->[2]), "y"),
 104         "$_->[0] == $_->[1] != $_->[2]";
 105     is join(",", "x", $_->[0] != $_->[1] == $_->[2], "y"),
 106         join(",", "x", !!($_->[0] != $_->[1] && $_->[1] == $_->[2]), "y"),
 107         "$_->[0] != $_->[1] == $_->[2]";
 108     is join(",", "x", $_->[0] < $_->[1] <= $_->[2], "y"),
 109         join(",", "x", !!($_->[0] < $_->[1] && $_->[1] <= $_->[2]), "y"),
 110         "$_->[0] < $_->[1] <= $_->[2]";
 111     is join(",", "x", $_->[0] > $_->[1] >= $_->[2], "y"),
 112         join(",", "x", !!($_->[0] > $_->[1] && $_->[1] >= $_->[2]), "y"),
 113         "$_->[0] > $_->[1] >= $_->[2]";
 114     is join(",", "x", $_->[0] < $_->[1] > $_->[2], "y"),
 115         join(",", "x", !!($_->[0] < $_->[1] && $_->[1] > $_->[2]), "y"),
 116         "$_->[0] < $_->[1] > $_->[2]";
 117     my $e = "";
 118     is join(",", "x",
 119             ($e .= "a", $_->[0]) == ($e .= "b", $_->[1]) !=
 120                 ($e .= "c", $_->[2]),
 121             "y"),
 122         join(",", "x", !!($_->[0] == $_->[1] && $_->[1] != $_->[2]), "y"),
 123         "$_->[0] == $_->[1] != $_->[2] with side effects";
 124     is $e, "ab".($_->[0] == $_->[1] ? "c" : ""), "operand evaluation order";
 125     $e = "";
 126     is join(",", "x",
 127             ($e .= "a", $_->[0]) < ($e .= "b", $_->[1]) <= ($e .= "c", $_->[2]),
 128             "y"),
 129         join(",", "x", !!($_->[0] < $_->[1] && $_->[1] <= $_->[2]), "y"),
 130         "$_->[0] < $_->[1] <= $_->[2] with side effects";
 131     is $e, "ab".($_->[0] < $_->[1] ? "c" : ""), "operand evaluation order";
 132     foreach my $p (1..9) {
 133         is join(",", "x", $_->[0] == $_->[1] != $_->[2] == $p, "y"),
 134             join(",", "x",
 135                 !!($_->[0] == $_->[1] && $_->[1] != $_->[2] && $_->[2] == $p),
 136                 "y"),
 137             "$_->[0] == $_->[1] != $_->[2] == $p";
 138         is join(",", "x", $_->[0] < $_->[1] <= $_->[2] > $p, "y"),
 139             join(",", "x",
 140                 !!($_->[0] < $_->[1] && $_->[1] <= $_->[2] && $_->[2] > $p),
 141                 "y"),
 142             "$_->[0] < $_->[1] <= $_->[2] > $p";
 143         $e = "";
 144         is join(",", "x",
 145                 ($e .= "a", $_->[0]) == ($e .= "b", $_->[1]) !=
 146                     ($e .= "c", $_->[2]) == ($e .= "d", $p),
 147                 "y"),
 148             join(",", "x",
 149                 !!($_->[0] == $_->[1] && $_->[1] != $_->[2] && $_->[2] == $p),
 150                 "y"),
 151             "$_->[0] == $_->[1] != $_->[2] == $p with side effects";
 152         is $e,
 153             "ab".($_->[0] == $_->[1] ?
 154                     ("c".($_->[1] != $_->[2] ? "d" : "")) : ""),
 155             "operand evaluation order";
 156         $e = "";
 157         is join(",", "x",
 158                 ($e .= "a", $_->[0]) < ($e .= "b", $_->[1]) <=
 159                     ($e .= "c", $_->[2]) > ($e .= "d", $p),
 160                 "y"),
 161             join(",", "x",
 162                 !!($_->[0] < $_->[1] && $_->[1] <= $_->[2] && $_->[2] > $p),
 163                 "y"),
 164             "$_->[0] < $_->[1] <= $_->[2] > $p with side effects";
 165         is $e,
 166             "ab".($_->[0] < $_->[1] ?
 167                     ("c".($_->[1] <= $_->[2] ? "d" : "")) : ""),
 168             "operand evaluation order";
 169     }
 170 }