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