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