1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 require "./test.pl"; 6 set_up_inc("../lib"); 7} 8 9use feature "isa"; 10no warnings qw(experimental::smartmatch experimental::isa); 11 12my @cheqop = qw(== != eq ne); 13my @nceqop = qw(<=> cmp ~~); 14my @chrelop = qw(< > <= >= lt gt le ge); 15my @ncrelop = qw(isa); 16 17foreach 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} 23foreach 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} 29foreach 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 40foreach 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} 46foreach 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} 52foreach 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 63foreach my $e0 (@cheqop) { 64 foreach my $e1 (@cheqop) { 65 isnt eval("sub { \$a $e0 \$b $e1 \$c }"), undef, "$e0 $e1 legal"; 66 } 67} 68foreach my $r0 (@chrelop) { 69 foreach my $r1 (@chrelop) { 70 isnt eval("sub { \$a $r0 \$b $r1 \$c }"), undef, "$r0 $r1 legal"; 71 } 72} 73foreach 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} 81foreach 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 90foreach( 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 166fresh_perl_is(<<'CODE', "", {}, "stack underflow"); 167no warnings "uninitialized"; 168my $v; 1691 < $v < 2; 1702 < $v < 3; 171CODE 172 173done_testing(); 174