This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
92a2f4133df7a599031feac5315f68f22c53b9fc
[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 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 }