Integrate mainline
[p5sagit/p5-mst-13.2.git] / t / op / arith.t
CommitLineData
7dca457a 1#!./perl -w
54310121 2
7f45fac2 3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6}
7
8print "1..134\n";
54310121 9
10sub try ($$) {
11 print +($_[1] ? "ok" : "not ok"), " $_[0]\n";
12}
7dca457a 13sub tryeq ($$$) {
14 if ($_[1] == $_[2]) {
15 print "ok $_[0]\n";
16 } else {
17 print "not ok $_[0] # $_[1] != $_[2]\n";
18 }
19}
800e6488 20sub tryeq_sloppy ($$$) {
21 if ($_[1] == $_[2]) {
22 print "ok $_[0]\n";
23 } else {
24 my $error = abs ($_[1] - $_[2]) / $_[1];
25 if ($error < 1e-10) {
26 print "ok $_[0] # $_[1] is close to $_[2], \$^O eq $^O\n";
27 } else {
28 print "not ok $_[0] # $_[1] != $_[2]\n";
29 }
30 }
31}
54310121 32
7dca457a 33tryeq 1, 13 % 4, 1;
34tryeq 2, -13 % 4, 3;
35tryeq 3, 13 % -4, -3;
36tryeq 4, -13 % -4, -1;
65843c0f 37
38my $limit = 1e6;
39
40# Division (and modulo) of floating point numbers
41# seem to be rather sloppy in Cray.
42$limit = 1e8 if $^O eq 'unicos';
43
44try 5, abs( 13e21 % 4e21 - 1e21) < $limit;
45try 6, abs(-13e21 % 4e21 - 3e21) < $limit;
46try 7, abs( 13e21 % -4e21 - -3e21) < $limit;
47try 8, abs(-13e21 % -4e21 - -1e21) < $limit;
d658dc55 48
49# UVs should behave properly
50
7dca457a 51tryeq 9, 4063328477 % 65535, 27407;
52tryeq 10, 4063328477 % 4063328476, 1;
53tryeq 11, 4063328477 % 2031664238, 1;
54tryeq 12, 2031664238 % 4063328477, 2031664238;
55
56# These should trigger wrapping on 32 bit IVs and UVs
57
58tryeq 13, 2147483647 + 0, 2147483647;
59
60# IV + IV promote to UV
61tryeq 14, 2147483647 + 1, 2147483648;
62tryeq 15, 2147483640 + 10, 2147483650;
63tryeq 16, 2147483647 + 2147483647, 4294967294;
64# IV + UV promote to NV
65tryeq 17, 2147483647 + 2147483649, 4294967296;
66# UV + IV promote to NV
67tryeq 18, 4294967294 + 2, 4294967296;
68# UV + UV promote to NV
69tryeq 19, 4294967295 + 4294967295, 8589934590;
70
71# UV + IV to IV
72tryeq 20, 2147483648 + -1, 2147483647;
73tryeq 21, 2147483650 + -10, 2147483640;
74# IV + UV to IV
75tryeq 22, -1 + 2147483648, 2147483647;
76tryeq 23, -10 + 4294967294, 4294967284;
77# IV + IV to NV
78tryeq 24, -2147483648 + -2147483648, -4294967296;
79tryeq 25, -2147483640 + -10, -2147483650;
80
81# Hmm. Don't forget the simple stuff
82tryeq 26, 1 + 1, 2;
83tryeq 27, 4 + -2, 2;
84tryeq 28, -10 + 100, 90;
85tryeq 29, -7 + -9, -16;
86tryeq 30, -63 + +2, -61;
87tryeq 31, 4 + -1, 3;
88tryeq 32, -1 + 1, 0;
89tryeq 33, +29 + -29, 0;
90tryeq 34, -1 + 4, 3;
91tryeq 35, +4 + -17, -13;
92
93# subtraction
94tryeq 36, 3 - 1, 2;
95tryeq 37, 3 - 15, -12;
96tryeq 38, 3 - -7, 10;
97tryeq 39, -156 - 5, -161;
98tryeq 40, -156 - -5, -151;
99tryeq 41, -5 - -12, 7;
100tryeq 42, -3 - -3, 0;
101tryeq 43, 15 - 15, 0;
102
103tryeq 44, 2147483647 - 0, 2147483647;
104tryeq 45, 2147483648 - 0, 2147483648;
105tryeq 46, -2147483648 - 0, -2147483648;
106
107tryeq 47, 0 - -2147483647, 2147483647;
108tryeq 48, -1 - -2147483648, 2147483647;
109tryeq 49, 2 - -2147483648, 2147483650;
110
111tryeq 50, 4294967294 - 3, 4294967291;
112tryeq 51, -2147483648 - -1, -2147483647;
113
114# IV - IV promote to UV
115tryeq 52, 2147483647 - -1, 2147483648;
116tryeq 53, 2147483647 - -2147483648, 4294967295;
117# UV - IV promote to NV
118tryeq 54, 4294967294 - -3, 4294967297;
119# IV - IV promote to NV
120tryeq 55, -2147483648 - +1, -2147483649;
121# UV - UV promote to IV
122tryeq 56, 2147483648 - 2147483650, -2;
123# IV - UV promote to IV
124tryeq 57, 2000000000 - 4000000000, -2000000000;
125
126# No warnings should appear;
127my $a;
128$a += 1;
129tryeq 58, $a, 1;
130undef $a;
131$a += -1;
132tryeq 59, $a, -1;
133undef $a;
134$a += 4294967290;
135tryeq 60, $a, 4294967290;
136undef $a;
137$a += -4294967290;
138tryeq 61, $a, -4294967290;
139undef $a;
140$a += 4294967297;
141tryeq 62, $a, 4294967297;
142undef $a;
143$a += -4294967297;
144tryeq 63, $a, -4294967297;
145
146my $s;
147$s -= 1;
148tryeq 64, $s, -1;
149undef $s;
150$s -= -1;
151tryeq 65, $s, +1;
152undef $s;
153$s -= -4294967290;
154tryeq 66, $s, +4294967290;
155undef $s;
156$s -= 4294967290;
157tryeq 67, $s, -4294967290;
158undef $s;
159$s -= 4294967297;
160tryeq 68, $s, -4294967297;
161undef $s;
162$s -= -4294967297;
163tryeq 69, $s, +4294967297;
164
165# Multiplication
166
167tryeq 70, 1 * 3, 3;
168tryeq 71, -2 * 3, -6;
169tryeq 72, 3 * -3, -9;
170tryeq 73, -4 * -3, 12;
171
172# check with 0xFFFF and 0xFFFF
173tryeq 74, 65535 * 65535, 4294836225;
174tryeq 75, 65535 * -65535, -4294836225;
175tryeq 76, -65535 * 65535, -4294836225;
176tryeq 77, -65535 * -65535, 4294836225;
177
178# check with 0xFFFF and 0x10001
179tryeq 78, 65535 * 65537, 4294967295;
180tryeq 79, 65535 * -65537, -4294967295;
181tryeq 80, -65535 * 65537, -4294967295;
182tryeq 81, -65535 * -65537, 4294967295;
183
184# check with 0x10001 and 0xFFFF
185tryeq 82, 65537 * 65535, 4294967295;
186tryeq 83, 65537 * -65535, -4294967295;
187tryeq 84, -65537 * 65535, -4294967295;
188tryeq 85, -65537 * -65535, 4294967295;
189
190# These should all be dones as NVs
191tryeq 86, 65537 * 65537, 4295098369;
192tryeq 87, 65537 * -65537, -4295098369;
193tryeq 88, -65537 * 65537, -4295098369;
194tryeq 89, -65537 * -65537, 4295098369;
195
196# will overflow an IV (in 32-bit)
197tryeq 90, 46340 * 46342, 0x80001218;
198tryeq 91, 46340 * -46342, -0x80001218;
199tryeq 92, -46340 * 46342, -0x80001218;
200tryeq 93, -46340 * -46342, 0x80001218;
201
202tryeq 94, 46342 * 46340, 0x80001218;
203tryeq 95, 46342 * -46340, -0x80001218;
204tryeq 96, -46342 * 46340, -0x80001218;
205tryeq 97, -46342 * -46340, 0x80001218;
206
207# will overflow a positive IV (in 32-bit)
208tryeq 98, 65536 * 32768, 0x80000000;
209tryeq 99, 65536 * -32768, -0x80000000;
210tryeq 100, -65536 * 32768, -0x80000000;
211tryeq 101, -65536 * -32768, 0x80000000;
212
213tryeq 102, 32768 * 65536, 0x80000000;
214tryeq 103, 32768 * -65536, -0x80000000;
215tryeq 104, -32768 * 65536, -0x80000000;
216tryeq 105, -32768 * -65536, 0x80000000;
217
218# 2147483647 is prime. bah.
219
220tryeq 106, 46339 * 46341, 0x7ffea80f;
221tryeq 107, 46339 * -46341, -0x7ffea80f;
222tryeq 108, -46339 * 46341, -0x7ffea80f;
223tryeq 109, -46339 * -46341, 0x7ffea80f;
96a05aee 224
225# leading space should be ignored
226
227tryeq 110, 1 + " 1", 2;
228tryeq 111, 3 + " -1", 2;
229tryeq 112, 1.2, " 1.2";
230tryeq 113, -1.2, " -1.2";
5479d192 231
232# divide
233
234tryeq 114, 28/14, 2;
235tryeq 115, 28/-7, -4;
236tryeq 116, -28/4, -7;
237tryeq 117, -28/-2, 14;
238
239tryeq 118, 0x80000000/1, 0x80000000;
240tryeq 119, 0x80000000/-1, -0x80000000;
241tryeq 120, -0x80000000/1, -0x80000000;
242tryeq 121, -0x80000000/-1, 0x80000000;
243
244# The example for sloppy divide, rigged to avoid the peephole optimiser.
245tryeq 122, "20." / "5.", 4;
246
247tryeq 123, 2.5 / 2, 1.25;
248tryeq 124, 3.5 / -2, -1.75;
249tryeq 125, -4.5 / 2, -2.25;
250tryeq 126, -5.5 / -2, 2.75;
251
252# Bluuurg if your floating point can't accurately cope with powers of 2
e7311069 253# [I suspect this is parsing string->float problems, not actual arith]
800e6488 254tryeq_sloppy 127, 18446744073709551616/1, 18446744073709551616; # Bluuurg
5479d192 255tryeq 128, 18446744073709551616/2, 9223372036854775808;
256tryeq 129, 18446744073709551616/4294967296, 4294967296;
257tryeq 130, 18446744073709551616/9223372036854775808, 2;
e7311069 258
259{
260 # The peephole optimiser is wrong to think that it can substitute intops
261 # in place of regular ops, because i_multiply can overflow.
262 # Bug reported by "Sisyphus" <kalinabears@hdc.com.au>
263 my $n = 1127;
264
265 my $float = ($n % 1000) * 167772160.0;
266 tryeq 131, $float, 21307064320;
267
268 # On a 32 bit machine, if the i_multiply op is used, you will probably get
269 # -167772160. It's actually undefined behaviour, so anything may happen.
270 my $int = ($n % 1000) * 167772160;
271 tryeq 132, $int, 21307064320;
e228fed9 272
273 my $t = time;
274 my $t1000 = time() * 1000;
275 try 133, abs($t1000 -1000 * $t) <= 2000;
e7311069 276}
7f45fac2 277
278if ($^O eq 'vos') {
279 print "not ok 134 # TODO VOS raises SIGFPE instead of producing infinity.\n";
280} else {
281 # The computation of $v should overflow and produce "infinity"
282 # on any system whose max exponent is less than 10**1506.
283 # The exact string used to represent infinity varies by OS,
284 # so we don't test for it; all we care is that we don't die.
285 #
286 # Perl considers it to be an error if SIGFPE is raised.
287 # Chances are the interpreter will die, since it doesn't set
288 # up a handler for SIGFPE. That's why this test is last; to
289 # minimize the number of test failures. --PG
290
291 my $n = 5000;
292 my $v = 2;
293 while (--$n)
294 {
295 $v *= 2;
296 }
297 print "ok 134\n";
298}