This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
t/win32/runenv.t: Correct syntax error reported by bulk88++.
[perl5.git] / t / op / arith.t
CommitLineData
7dca457a 1#!./perl -w
54310121 2
7f45fac2
PG
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6}
7
43089d1e 8print "1..167\n";
54310121
PP
9
10sub try ($$) {
11 print +($_[1] ? "ok" : "not ok"), " $_[0]\n";
12}
7dca457a
NC
13sub tryeq ($$$) {
14 if ($_[1] == $_[2]) {
15 print "ok $_[0]\n";
16 } else {
17 print "not ok $_[0] # $_[1] != $_[2]\n";
18 }
19}
800e6488
JH
20sub tryeq_sloppy ($$$) {
21 if ($_[1] == $_[2]) {
22 print "ok $_[0]\n";
23 } else {
66d2c7cb 24 my $error = abs (($_[1] - $_[2]) / $_[1]);
fbe3e8bd 25 if ($error < 1e-9) {
800e6488
JH
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
a4474c9e
DD
33my $T = 1;
34tryeq $T++, 13 % 4, 1;
35tryeq $T++, -13 % 4, 3;
36tryeq $T++, 13 % -4, -3;
37tryeq $T++, -13 % -4, -1;
38
39# Give abs() a good work-out before using it in anger
40tryeq $T++, abs(0), 0;
41tryeq $T++, abs(1), 1;
42tryeq $T++, abs(-1), 1;
43tryeq $T++, abs(2147483647), 2147483647;
44tryeq $T++, abs(-2147483647), 2147483647;
45tryeq $T++, abs(4294967295), 4294967295;
46tryeq $T++, abs(-4294967295), 4294967295;
47tryeq $T++, abs(9223372036854775807), 9223372036854775807;
48tryeq $T++, abs(-9223372036854775807), 9223372036854775807;
49tryeq $T++, abs(1e50), 1e50; # Assume no change whatever; no slop needed
50tryeq $T++, abs(-1e50), 1e50; # Assume only sign bit flipped
65843c0f
JH
51
52my $limit = 1e6;
53
54# Division (and modulo) of floating point numbers
55# seem to be rather sloppy in Cray.
56$limit = 1e8 if $^O eq 'unicos';
57
a4474c9e
DD
58try $T++, abs( 13e21 % 4e21 - 1e21) < $limit;
59try $T++, abs(-13e21 % 4e21 - 3e21) < $limit;
60try $T++, abs( 13e21 % -4e21 - -3e21) < $limit;
61try $T++, abs(-13e21 % -4e21 - -1e21) < $limit;
d658dc55
GS
62
63# UVs should behave properly
64
a4474c9e
DD
65tryeq $T++, 4063328477 % 65535, 27407;
66tryeq $T++, 4063328477 % 4063328476, 1;
67tryeq $T++, 4063328477 % 2031664238, 1;
68tryeq $T++, 2031664238 % 4063328477, 2031664238;
7dca457a
NC
69
70# These should trigger wrapping on 32 bit IVs and UVs
71
a4474c9e 72tryeq $T++, 2147483647 + 0, 2147483647;
7dca457a
NC
73
74# IV + IV promote to UV
a4474c9e
DD
75tryeq $T++, 2147483647 + 1, 2147483648;
76tryeq $T++, 2147483640 + 10, 2147483650;
77tryeq $T++, 2147483647 + 2147483647, 4294967294;
7dca457a 78# IV + UV promote to NV
a4474c9e 79tryeq $T++, 2147483647 + 2147483649, 4294967296;
7dca457a 80# UV + IV promote to NV
a4474c9e 81tryeq $T++, 4294967294 + 2, 4294967296;
7dca457a 82# UV + UV promote to NV
a4474c9e 83tryeq $T++, 4294967295 + 4294967295, 8589934590;
7dca457a
NC
84
85# UV + IV to IV
a4474c9e
DD
86tryeq $T++, 2147483648 + -1, 2147483647;
87tryeq $T++, 2147483650 + -10, 2147483640;
7dca457a 88# IV + UV to IV
a4474c9e
DD
89tryeq $T++, -1 + 2147483648, 2147483647;
90tryeq $T++, -10 + 4294967294, 4294967284;
7dca457a 91# IV + IV to NV
a4474c9e
DD
92tryeq $T++, -2147483648 + -2147483648, -4294967296;
93tryeq $T++, -2147483640 + -10, -2147483650;
7dca457a
NC
94
95# Hmm. Don't forget the simple stuff
a4474c9e
DD
96tryeq $T++, 1 + 1, 2;
97tryeq $T++, 4 + -2, 2;
98tryeq $T++, -10 + 100, 90;
99tryeq $T++, -7 + -9, -16;
100tryeq $T++, -63 + +2, -61;
101tryeq $T++, 4 + -1, 3;
102tryeq $T++, -1 + 1, 0;
103tryeq $T++, +29 + -29, 0;
104tryeq $T++, -1 + 4, 3;
105tryeq $T++, +4 + -17, -13;
7dca457a
NC
106
107# subtraction
a4474c9e
DD
108tryeq $T++, 3 - 1, 2;
109tryeq $T++, 3 - 15, -12;
110tryeq $T++, 3 - -7, 10;
111tryeq $T++, -156 - 5, -161;
112tryeq $T++, -156 - -5, -151;
113tryeq $T++, -5 - -12, 7;
114tryeq $T++, -3 - -3, 0;
115tryeq $T++, 15 - 15, 0;
116
117tryeq $T++, 2147483647 - 0, 2147483647;
118tryeq $T++, 2147483648 - 0, 2147483648;
119tryeq $T++, -2147483648 - 0, -2147483648;
120
121tryeq $T++, 0 - -2147483647, 2147483647;
122tryeq $T++, -1 - -2147483648, 2147483647;
123tryeq $T++, 2 - -2147483648, 2147483650;
124
125tryeq $T++, 4294967294 - 3, 4294967291;
126tryeq $T++, -2147483648 - -1, -2147483647;
7dca457a
NC
127
128# IV - IV promote to UV
a4474c9e
DD
129tryeq $T++, 2147483647 - -1, 2147483648;
130tryeq $T++, 2147483647 - -2147483648, 4294967295;
7dca457a 131# UV - IV promote to NV
a4474c9e 132tryeq $T++, 4294967294 - -3, 4294967297;
7dca457a 133# IV - IV promote to NV
a4474c9e 134tryeq $T++, -2147483648 - +1, -2147483649;
7dca457a 135# UV - UV promote to IV
a4474c9e 136tryeq $T++, 2147483648 - 2147483650, -2;
7dca457a 137# IV - UV promote to IV
a4474c9e 138tryeq $T++, 2000000000 - 4000000000, -2000000000;
7dca457a
NC
139
140# No warnings should appear;
141my $a;
142$a += 1;
a4474c9e 143tryeq $T++, $a, 1;
7dca457a
NC
144undef $a;
145$a += -1;
a4474c9e 146tryeq $T++, $a, -1;
7dca457a
NC
147undef $a;
148$a += 4294967290;
a4474c9e 149tryeq $T++, $a, 4294967290;
7dca457a
NC
150undef $a;
151$a += -4294967290;
a4474c9e 152tryeq $T++, $a, -4294967290;
7dca457a
NC
153undef $a;
154$a += 4294967297;
a4474c9e 155tryeq $T++, $a, 4294967297;
7dca457a
NC
156undef $a;
157$a += -4294967297;
a4474c9e 158tryeq $T++, $a, -4294967297;
7dca457a
NC
159
160my $s;
161$s -= 1;
a4474c9e 162tryeq $T++, $s, -1;
7dca457a
NC
163undef $s;
164$s -= -1;
a4474c9e 165tryeq $T++, $s, +1;
7dca457a
NC
166undef $s;
167$s -= -4294967290;
a4474c9e 168tryeq $T++, $s, +4294967290;
7dca457a
NC
169undef $s;
170$s -= 4294967290;
a4474c9e 171tryeq $T++, $s, -4294967290;
7dca457a
NC
172undef $s;
173$s -= 4294967297;
a4474c9e 174tryeq $T++, $s, -4294967297;
7dca457a
NC
175undef $s;
176$s -= -4294967297;
a4474c9e 177tryeq $T++, $s, +4294967297;
7dca457a
NC
178
179# Multiplication
180
a4474c9e
DD
181tryeq $T++, 1 * 3, 3;
182tryeq $T++, -2 * 3, -6;
183tryeq $T++, 3 * -3, -9;
184tryeq $T++, -4 * -3, 12;
7dca457a
NC
185
186# check with 0xFFFF and 0xFFFF
a4474c9e
DD
187tryeq $T++, 65535 * 65535, 4294836225;
188tryeq $T++, 65535 * -65535, -4294836225;
189tryeq $T++, -65535 * 65535, -4294836225;
190tryeq $T++, -65535 * -65535, 4294836225;
7dca457a
NC
191
192# check with 0xFFFF and 0x10001
a4474c9e
DD
193tryeq $T++, 65535 * 65537, 4294967295;
194tryeq $T++, 65535 * -65537, -4294967295;
195tryeq $T++, -65535 * 65537, -4294967295;
196tryeq $T++, -65535 * -65537, 4294967295;
7dca457a
NC
197
198# check with 0x10001 and 0xFFFF
a4474c9e
DD
199tryeq $T++, 65537 * 65535, 4294967295;
200tryeq $T++, 65537 * -65535, -4294967295;
201tryeq $T++, -65537 * 65535, -4294967295;
202tryeq $T++, -65537 * -65535, 4294967295;
7dca457a
NC
203
204# These should all be dones as NVs
a4474c9e
DD
205tryeq $T++, 65537 * 65537, 4295098369;
206tryeq $T++, 65537 * -65537, -4295098369;
207tryeq $T++, -65537 * 65537, -4295098369;
208tryeq $T++, -65537 * -65537, 4295098369;
7dca457a
NC
209
210# will overflow an IV (in 32-bit)
a4474c9e
DD
211tryeq $T++, 46340 * 46342, 0x80001218;
212tryeq $T++, 46340 * -46342, -0x80001218;
213tryeq $T++, -46340 * 46342, -0x80001218;
214tryeq $T++, -46340 * -46342, 0x80001218;
7dca457a 215
a4474c9e
DD
216tryeq $T++, 46342 * 46340, 0x80001218;
217tryeq $T++, 46342 * -46340, -0x80001218;
218tryeq $T++, -46342 * 46340, -0x80001218;
219tryeq $T++, -46342 * -46340, 0x80001218;
7dca457a
NC
220
221# will overflow a positive IV (in 32-bit)
a4474c9e
DD
222tryeq $T++, 65536 * 32768, 0x80000000;
223tryeq $T++, 65536 * -32768, -0x80000000;
224tryeq $T++, -65536 * 32768, -0x80000000;
225tryeq $T++, -65536 * -32768, 0x80000000;
7dca457a 226
a4474c9e
DD
227tryeq $T++, 32768 * 65536, 0x80000000;
228tryeq $T++, 32768 * -65536, -0x80000000;
229tryeq $T++, -32768 * 65536, -0x80000000;
230tryeq $T++, -32768 * -65536, 0x80000000;
7dca457a
NC
231
232# 2147483647 is prime. bah.
233
a4474c9e
DD
234tryeq $T++, 46339 * 46341, 0x7ffea80f;
235tryeq $T++, 46339 * -46341, -0x7ffea80f;
236tryeq $T++, -46339 * 46341, -0x7ffea80f;
237tryeq $T++, -46339 * -46341, 0x7ffea80f;
96a05aee
HS
238
239# leading space should be ignored
240
a4474c9e
DD
241tryeq $T++, 1 + " 1", 2;
242tryeq $T++, 3 + " -1", 2;
243tryeq $T++, 1.2, " 1.2";
244tryeq $T++, -1.2, " -1.2";
5479d192
NC
245
246# divide
247
a4474c9e
DD
248tryeq $T++, 28/14, 2;
249tryeq $T++, 28/-7, -4;
250tryeq $T++, -28/4, -7;
251tryeq $T++, -28/-2, 14;
5479d192 252
a4474c9e
DD
253tryeq $T++, 0x80000000/1, 0x80000000;
254tryeq $T++, 0x80000000/-1, -0x80000000;
255tryeq $T++, -0x80000000/1, -0x80000000;
256tryeq $T++, -0x80000000/-1, 0x80000000;
5479d192
NC
257
258# The example for sloppy divide, rigged to avoid the peephole optimiser.
a4474c9e 259tryeq_sloppy $T++, "20." / "5.", 4;
5479d192 260
a4474c9e
DD
261tryeq $T++, 2.5 / 2, 1.25;
262tryeq $T++, 3.5 / -2, -1.75;
263tryeq $T++, -4.5 / 2, -2.25;
264tryeq $T++, -5.5 / -2, 2.75;
5479d192
NC
265
266# Bluuurg if your floating point can't accurately cope with powers of 2
e7311069 267# [I suspect this is parsing string->float problems, not actual arith]
a4474c9e
DD
268tryeq_sloppy $T++, 18446744073709551616/1, 18446744073709551616; # Bluuurg
269tryeq_sloppy $T++, 18446744073709551616/2, 9223372036854775808;
270tryeq_sloppy $T++, 18446744073709551616/4294967296, 4294967296;
271tryeq_sloppy $T++, 18446744073709551616/9223372036854775808, 2;
e7311069
NC
272
273{
274 # The peephole optimiser is wrong to think that it can substitute intops
275 # in place of regular ops, because i_multiply can overflow.
276 # Bug reported by "Sisyphus" <kalinabears@hdc.com.au>
277 my $n = 1127;
278
279 my $float = ($n % 1000) * 167772160.0;
a4474c9e 280 tryeq_sloppy $T++, $float, 21307064320;
e7311069
NC
281
282 # On a 32 bit machine, if the i_multiply op is used, you will probably get
283 # -167772160. It's actually undefined behaviour, so anything may happen.
284 my $int = ($n % 1000) * 167772160;
a4474c9e 285 tryeq $T++, $int, 21307064320;
e228fed9 286
43089d1e
NC
287 my $float2 = ($n % 1000 + 0.0) * 167772160;
288 tryeq $T++, $float2, 21307064320;
289
290 my $int2 = ($n % 1000 + 0) * 167772160;
291 tryeq $T++, $int2, 21307064320;
292
293 # zero, but in a way that ought to be able to defeat any future optimizer:
294 my $zero = $$ - $$;
295 my $int3 = ($n % 1000 + $zero) * 167772160;
296 tryeq $T++, $int3, 21307064320;
297
e228fed9
MG
298 my $t = time;
299 my $t1000 = time() * 1000;
a4474c9e 300 try $T++, abs($t1000 -1000 * $t) <= 2000;
e7311069 301}
7f45fac2 302
43089d1e
NC
303{
304 # 64 bit variants
305 my $n = 1127;
306
307 my $float = ($n % 1000) * 720575940379279360.0;
308 tryeq_sloppy $T++, $float, 9.15131444281685e+19;
309
310 my $int = ($n % 1000) * 720575940379279360;
311 tryeq_sloppy $T++, $int, 9.15131444281685e+19;
312
313 my $float2 = ($n % 1000 + 0.0) * 720575940379279360;
314 tryeq_sloppy $T++, $float2, 9.15131444281685e+19;
315
316 my $int2 = ($n % 1000 + 0) * 720575940379279360;
317 tryeq_sloppy $T++, $int2, 9.15131444281685e+19;
318
319 # zero, but in a way that ought to be able to defeat any future optimizer:
320 my $zero = $$ - $$;
321 my $int3 = ($n % 1000 + $zero) * 720575940379279360;
322 tryeq_sloppy $T++, $int3, 9.15131444281685e+19;
323}
324
6332ff5c
JM
325my $vms_no_ieee;
326if ($^O eq 'VMS') {
a4474c9e
DD
327 use vars '%Config';
328 eval {require Config; import Config};
6332ff5c
JM
329 $vms_no_ieee = 1 unless defined($Config{useieee});
330}
331
332if ($^O eq 'vos') {
333 print "not ok ", $T++, " # TODO VOS raises SIGFPE instead of producing infinity.\n";
334}
335elsif ($vms_no_ieee) {
336 print $T++, " # SKIP -- the IEEE infinity model is unavailable in this configuration.\n"
337}
ad415dae 338elsif ($^O eq 'ultrix') {
a4474c9e 339 print "not ok ", $T++, " # TODO Ultrix enters deep nirvana instead of producing infinity.\n";
6332ff5c 340}
dfbc85ea 341else {
7f45fac2
PG
342 # The computation of $v should overflow and produce "infinity"
343 # on any system whose max exponent is less than 10**1506.
344 # The exact string used to represent infinity varies by OS,
345 # so we don't test for it; all we care is that we don't die.
346 #
347 # Perl considers it to be an error if SIGFPE is raised.
348 # Chances are the interpreter will die, since it doesn't set
349 # up a handler for SIGFPE. That's why this test is last; to
350 # minimize the number of test failures. --PG
351
352 my $n = 5000;
353 my $v = 2;
354 while (--$n)
355 {
356 $v *= 2;
357 }
a4474c9e 358 print "ok ", $T++, "\n";
7f45fac2 359}
01f91bf2
FC
360
361# [perl #109542] $1 and "$1" should be treated the same way
362"976562500000000" =~ /(\d+)/;
363$a = ($1 * 1024);
364$b = ("$1" * 1024);
365print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" * something\n';
366$a = (1024 * $1);
367$b = (1024 * "$1");
368print "not "x($a ne $b), "ok ", $T++, qq ' - something * \$1 vs "\$1"\n';
369$a = ($1 + 102400000000000);
370$b = ("$1" + 102400000000000);
371print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" + something\n';
372$a = (102400000000000 + $1);
373$b = (102400000000000 + "$1");
374print "not "x($a ne $b), "ok ", $T++, qq ' - something + \$1 vs "\$1"\n';
375$a = ($1 - 10240000000000000);
376$b = ("$1" - 10240000000000000);
377print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" - something\n';
378$a = (10240000000000000 - $1);
379$b = (10240000000000000 - "$1");
380print "not "x($a ne $b), "ok ", $T++, qq ' - something - \$1 vs "\$1"\n';
381"976562500" =~ /(\d+)/;
382$a = ($1 ** 2);
383$b = ("$1" ** 2);
384print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" ** something\n';
385"32" =~ /(\d+)/;
386$a = (3 ** $1);
387$b = (3 ** "$1");
388print "not "x($a ne $b), "ok ", $T++, qq ' - something ** \$1 vs "\$1"\n';
389"97656250000000000" =~ /(\d+)/;
390$a = ($1 / 10);
391$b = ("$1" / 10);
392print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" / something\n';
393"10" =~ /(\d+)/;
394$a = (97656250000000000 / $1);
395$b = (97656250000000000 / "$1");
396print "not "x($a ne $b), "ok ", $T++, qq ' - something / \$1 vs "\$1"\n';
397"97656250000000000" =~ /(\d+)/;
398$a = ($1 <=> 97656250000000001);
399$b = ("$1" <=> 97656250000000001);
400print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" <=> something\n';
401$a = (97656250000000001 <=> $1);
402$b = (97656250000000001 <=> "$1");
403print "not "x($a ne $b), "ok ", $T++, qq ' - something <=> \$1 vs "\$1"\n';
404"97656250000000001" =~ /(\d+)/;
405$a = ($1 % 97656250000000002);
406$b = ("$1" % 97656250000000002);
407print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" % something\n';
408$a = (97656250000000000 % $1);
409$b = (97656250000000000 % "$1");
410print "not "x($a ne $b), "ok ", $T++, qq ' - something % \$1 vs "\$1"\n';