This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
skip trying to constant fold an incomplete op tree
[perl5.git] / 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 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();