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);
  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 foreach my $c0 (@nceqop) {
  18     foreach my $c1 (@nceqop) {
  19         is eval("sub { \$a $c0 \$b $c1 \$c }"), undef,
  20             "$c0 $c1 non-associative";
  21     }
  22 }
  23 foreach my $c (@nceqop) {
  24     foreach my $e (@cheqop) {
  25         is eval("sub { \$a $c \$b $e \$c }"), undef, "$c $e non-associative";
  26         is eval("sub { \$a $e \$b $c \$c }"), undef, "$e $c non-associative";
  27     }
  28 }
  29 foreach my $c (@nceqop) {
  30     foreach my $e0 (@cheqop) {
  31         foreach my $e1 (@cheqop) {
  32             is eval("sub { \$a $c \$b $e0 \$c $e1 \$d }"), undef,
  33                 "$c $e0 $e1 non-associative";
  34             is eval("sub { \$a $e0 \$b $e1 \$c $c \$d }"), undef,
  35                 "$e0 $e1 $c non-associative";
  36         }
  37     }
  38 }
  39
  40 foreach my $c0 (@ncrelop) {
  41     foreach my $c1 (@ncrelop) {
  42         is eval("sub { \$a $c0 \$b $c1 \$c }"), undef,
  43             "$c0 $c1 non-associative";
  44     }
  45 }
  46 foreach my $c (@ncrelop) {
  47     foreach my $e (@chrelop) {
  48         is eval("sub { \$a $c \$b $e \$c }"), undef, "$c $e non-associative";
  49         is eval("sub { \$a $e \$b $c \$c }"), undef, "$e $c non-associative";
  50     }
  51 }
  52 foreach my $c (@ncrelop) {
  53     foreach my $e0 (@chrelop) {
  54         foreach my $e1 (@chrelop) {
  55             is eval("sub { \$a $c \$b $e0 \$c $e1 \$d }"), undef,
  56                 "$c $e0 $e1 non-associative";
  57             is eval("sub { \$a $e0 \$b $e1 \$c $c \$d }"), undef,
  58                 "$e0 $e1 $c non-associative";
  59         }
  60     }
  61 }
  62
  63 foreach my $e0 (@cheqop) {
  64     foreach my $e1 (@cheqop) {
  65         isnt eval("sub { \$a $e0 \$b $e1 \$c }"), undef, "$e0 $e1 legal";
  66     }
  67 }
  68 foreach my $r0 (@chrelop) {
  69     foreach my $r1 (@chrelop) {
  70         isnt eval("sub { \$a $r0 \$b $r1 \$c }"), undef, "$r0 $r1 legal";
  71     }
  72 }
  73 foreach my $e0 (@cheqop) {
  74     foreach my $e1 (@cheqop) {
  75         foreach my $e2 (@cheqop) {
  76             isnt eval("sub { \$a $e0 \$b $e1 \$c $e2 \$d }"), undef,
  77                 "$e0 $e1 $e2 legal";
  78         }
  79     }
  80 }
  81 foreach my $r0 (@chrelop) {
  82     foreach my $r1 (@chrelop) {
  83         foreach my $r2 (@chrelop) {
  84             isnt eval("sub { \$a $r0 \$b $r1 \$c $r2 \$d }"), undef,
  85                 "$r0 $r1 $r2 legal";
  86         }
  87     }
  88 }
  89
  90 foreach(
  91     [5,3,2], [5,3,3], [5,3,4], [5,3,5], [5,3,6],
  92     [5,5,4], [5,5,5], [5,5,6],
  93     [5,7,4], [5,7,5], [5,7,6], [5,7,7], [5,7,8],
  94 ) {
  95     is join(",", "x", $_->[0] == $_->[1] != $_->[2], "y"),
  96         join(",", "x", !!($_->[0] == $_->[1] && $_->[1] != $_->[2]), "y"),
  97         "$_->[0] == $_->[1] != $_->[2]";
  98     is join(",", "x", $_->[0] != $_->[1] == $_->[2], "y"),
  99         join(",", "x", !!($_->[0] != $_->[1] && $_->[1] == $_->[2]), "y"),
 100         "$_->[0] != $_->[1] == $_->[2]";
 101     is join(",", "x", $_->[0] < $_->[1] <= $_->[2], "y"),
 102         join(",", "x", !!($_->[0] < $_->[1] && $_->[1] <= $_->[2]), "y"),
 103         "$_->[0] < $_->[1] <= $_->[2]";
 104     is join(",", "x", $_->[0] > $_->[1] >= $_->[2], "y"),
 105         join(",", "x", !!($_->[0] > $_->[1] && $_->[1] >= $_->[2]), "y"),
 106         "$_->[0] > $_->[1] >= $_->[2]";
 107     is join(",", "x", $_->[0] < $_->[1] > $_->[2], "y"),
 108         join(",", "x", !!($_->[0] < $_->[1] && $_->[1] > $_->[2]), "y"),
 109         "$_->[0] < $_->[1] > $_->[2]";
 110     my $e = "";
 111     is join(",", "x",
 112             ($e .= "a", $_->[0]) == ($e .= "b", $_->[1]) !=
 113                 ($e .= "c", $_->[2]),
 114             "y"),
 115         join(",", "x", !!($_->[0] == $_->[1] && $_->[1] != $_->[2]), "y"),
 116         "$_->[0] == $_->[1] != $_->[2] with side effects";
 117     is $e, "ab".($_->[0] == $_->[1] ? "c" : ""), "operand evaluation order";
 118     $e = "";
 119     is join(",", "x",
 120             ($e .= "a", $_->[0]) < ($e .= "b", $_->[1]) <= ($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     foreach my $p (1..9) {
 126         is join(",", "x", $_->[0] == $_->[1] != $_->[2] == $p, "y"),
 127             join(",", "x",
 128                 !!($_->[0] == $_->[1] && $_->[1] != $_->[2] && $_->[2] == $p),
 129                 "y"),
 130             "$_->[0] == $_->[1] != $_->[2] == $p";
 131         is join(",", "x", $_->[0] < $_->[1] <= $_->[2] > $p, "y"),
 132             join(",", "x",
 133                 !!($_->[0] < $_->[1] && $_->[1] <= $_->[2] && $_->[2] > $p),
 134                 "y"),
 135             "$_->[0] < $_->[1] <= $_->[2] > $p";
 136         $e = "";
 137         is join(",", "x",
 138                 ($e .= "a", $_->[0]) == ($e .= "b", $_->[1]) !=
 139                     ($e .= "c", $_->[2]) == ($e .= "d", $p),
 140                 "y"),
 141             join(",", "x",
 142                 !!($_->[0] == $_->[1] && $_->[1] != $_->[2] && $_->[2] == $p),
 143                 "y"),
 144             "$_->[0] == $_->[1] != $_->[2] == $p with side effects";
 145         is $e,
 146             "ab".($_->[0] == $_->[1] ?
 147                     ("c".($_->[1] != $_->[2] ? "d" : "")) : ""),
 148             "operand evaluation order";
 149         $e = "";
 150         is join(",", "x",
 151                 ($e .= "a", $_->[0]) < ($e .= "b", $_->[1]) <=
 152                     ($e .= "c", $_->[2]) > ($e .= "d", $p),
 153                 "y"),
 154             join(",", "x",
 155                 !!($_->[0] < $_->[1] && $_->[1] <= $_->[2] && $_->[2] > $p),
 156                 "y"),
 157             "$_->[0] < $_->[1] <= $_->[2] > $p with side effects";
 158         is $e,
 159             "ab".($_->[0] < $_->[1] ?
 160                     ("c".($_->[1] <= $_->[2] ? "d" : "")) : ""),
 161             "operand evaluation order";
 162     }
 163 }
 164
 165 # https://github.com/Perl/perl5/issues/18380
 166 fresh_perl_is(<<'CODE', "", {}, "stack underflow");
 167 no warnings "uninitialized";
 168 my $v;
 169 1 < $v < 2;
 170 2 < $v < 3;
 171 CODE
 172
 173 done_testing();