9 # This file has been placed in t/opbasic to indicate that it should not use
10 # functions imported from t/test.pl or Test::More, as those programs/libraries
11 # use operators which are what is being tested in this file.
16 print +($_[1] ? "ok" : "not ok"), " $_[0] - $_[2]\n";
22 print "not ok $_[0] # $_[1] != $_[2]";
26 sub tryeq_sloppy ($$$$) {
30 my $error = abs (($_[1] - $_[2]) / $_[1]);
32 print "ok $_[0] # $_[1] is close to $_[2], \$^O eq $^O";
34 print "not ok $_[0] # $_[1] != $_[2]";
41 tryeq $T++, 13 % 4, 1, 'modulo: positive positive';
42 tryeq $T++, -13 % 4, 3, 'modulo: negative positive';
43 tryeq $T++, 13 % -4, -3, 'modulo: positive negative';
44 tryeq $T++, -13 % -4, -1, 'modulo: negative negative';
46 # Give abs() a good work-out before using it in anger
47 tryeq $T++, abs(0), 0, 'abs(): 0 0';
48 tryeq $T++, abs(1), 1, 'abs(): 1 1';
49 tryeq $T++, abs(-1), 1, 'abs(): -1 1';
50 tryeq $T++, abs(2147483647), 2147483647, 'abs(): 2**31-1: pos pos';
51 tryeq $T++, abs(-2147483647), 2147483647, 'abs(): 2**31-1: neg pos';
52 tryeq $T++, abs(4294967295), 4294967295, 'abs(): 2**32-1: pos pos';
53 tryeq $T++, abs(-4294967295), 4294967295, 'abs(): 2**32-1: neg pos';
54 tryeq $T++, abs(9223372036854775807), 9223372036854775807,
55 'abs(): 2**63-1: pos pos';
56 tryeq $T++, abs(-9223372036854775807), 9223372036854775807,
57 'abs(): 2**63-1: neg pos';
58 # Assume no change whatever; no slop needed
59 tryeq $T++, abs(1e50), 1e50, 'abs(): 1e50: pos pos';
60 # Assume only sign bit flipped
61 tryeq $T++, abs(-1e50), 1e50, 'abs(): 1e50: neg pos';
65 # Division (and modulo) of floating point numbers
66 # seem to be rather sloppy in Cray.
67 $limit = 1e8 if $^O eq 'unicos';
69 try $T++, abs( 13e21 % 4e21 - 1e21) < $limit, 'abs() for floating point';
70 try $T++, abs(-13e21 % 4e21 - 3e21) < $limit, 'abs() for floating point';
71 try $T++, abs( 13e21 % -4e21 - -3e21) < $limit, 'abs() for floating point';
72 try $T++, abs(-13e21 % -4e21 - -1e21) < $limit, 'abs() for floating point';
74 tryeq $T++, 4063328477 % 65535, 27407, 'UV behaves properly: modulo';
75 tryeq $T++, 4063328477 % 4063328476, 1, 'UV behaves properly: modulo';
76 tryeq $T++, 4063328477 % 2031664238, 1, 'UV behaves properly: modulo';
77 tryeq $T++, 2031664238 % 4063328477, 2031664238,
78 'UV behaves properly: modulo';
80 tryeq $T++, 2147483647 + 0, 2147483647,
81 'trigger wrapping on 32 bit IVs and UVs';
83 tryeq $T++, 2147483647 + 1, 2147483648, 'IV + IV promotes to UV';
84 tryeq $T++, 2147483640 + 10, 2147483650, 'IV + IV promotes to UV';
85 tryeq $T++, 2147483647 + 2147483647, 4294967294, 'IV + IV promotes to UV';
86 tryeq $T++, 2147483647 + 2147483649, 4294967296, 'IV + UV promotes to NV';
87 tryeq $T++, 4294967294 + 2, 4294967296, 'UV + IV promotes to NV';
88 tryeq $T++, 4294967295 + 4294967295, 8589934590, 'UV + UV promotes to NV';
90 tryeq $T++, 2147483648 + -1, 2147483647, 'UV + IV promotes to IV';
91 tryeq $T++, 2147483650 + -10, 2147483640, 'UV + IV promotes to IV';
92 tryeq $T++, -1 + 2147483648, 2147483647, 'IV + UV promotes to IV';
93 tryeq $T++, -10 + 4294967294, 4294967284, 'IV + UV promotes to IV';
94 tryeq $T++, -2147483648 + -2147483648, -4294967296, 'IV + IV promotes to NV';
95 tryeq $T++, -2147483640 + -10, -2147483650, 'IV + IV promotes to NV';
97 # Hmm. Do not forget the simple stuff
99 tryeq $T++, 1 + 1, 2, 'addition of 2 positive integers';
100 tryeq $T++, 4 + -2, 2, 'addition of positive and negative integer';
101 tryeq $T++, -10 + 100, 90, 'addition of negative and positive integer';
102 tryeq $T++, -7 + -9, -16, 'addition of 2 negative integers';
103 tryeq $T++, -63 + +2, -61, 'addition of signed negative and positive integers';
104 tryeq $T++, 4 + -1, 3, 'addition of positive and negative integer';
105 tryeq $T++, -1 + 1, 0, 'addition which sums to 0';
106 tryeq $T++, +29 + -29, 0, 'addition which sums to 0';
107 tryeq $T++, -1 + 4, 3, 'addition of signed negative and positive integers';
108 tryeq $T++, +4 + -17, -13, 'addition of signed positive and negative integers';
111 tryeq $T++, 3 - 1, 2, 'subtraction of two positive integers';
112 tryeq $T++, 3 - 15, -12,
113 'subtraction of two positive integers: minuend smaller';
114 tryeq $T++, 3 - -7, 10, 'subtraction of positive and negative integer';
115 tryeq $T++, -156 - 5, -161, 'subtraction of negative and positive integer';
116 tryeq $T++, -156 - -5, -151, 'subtraction of two negative integers';
117 tryeq $T++, -5 - -12, 7,
118 'subtraction of two negative integers: minuend smaller';
119 tryeq $T++, -3 - -3, 0, 'subtraction of two negative integers with result of 0';
120 tryeq $T++, 15 - 15, 0, 'subtraction of two positive integers with result of 0';
121 tryeq $T++, 2147483647 - 0, 2147483647, 'subtraction from large integer';
122 tryeq $T++, 2147483648 - 0, 2147483648, 'subtraction from large integer';
123 tryeq $T++, -2147483648 - 0, -2147483648,
124 'subtraction from large negative integer';
125 tryeq $T++, 0 - -2147483647, 2147483647,
126 'subtraction of large negative integer from 0';
127 tryeq $T++, -1 - -2147483648, 2147483647,
128 'subtraction of large negative integer from negative integer';
129 tryeq $T++, 2 - -2147483648, 2147483650,
130 'subtraction of large negative integer from positive integer';
131 tryeq $T++, 4294967294 - 3, 4294967291, 'subtraction from large integer';
132 tryeq $T++, -2147483648 - -1, -2147483647,
133 'subtraction from large negative integer';
134 tryeq $T++, 2147483647 - -1, 2147483648, 'IV - IV promote to UV';
135 tryeq $T++, 2147483647 - -2147483648, 4294967295, 'IV - IV promote to UV';
136 tryeq $T++, 4294967294 - -3, 4294967297, 'UV - IV promote to NV';
137 tryeq $T++, -2147483648 - +1, -2147483649, 'IV - IV promote to NV';
138 tryeq $T++, 2147483648 - 2147483650, -2, 'UV - UV promote to IV';
139 tryeq $T++, 2000000000 - 4000000000, -2000000000, 'IV - UV promote to IV';
141 # No warnings should appear;
144 tryeq $T++, $a, 1, '+= with positive';
147 tryeq $T++, $a, -1, '+= with negative';
150 tryeq $T++, $a, 4294967290, '+= with positive';
153 tryeq $T++, $a, -4294967290, '+= with negative';
156 tryeq $T++, $a, 4294967297, '+= with positive';
159 tryeq $T++, $a, -4294967297, '+= with negative';
163 tryeq $T++, $s, -1, '-= with positive';
166 tryeq $T++, $s, +1, '-= with negative';
169 tryeq $T++, $s, +4294967290, '-= with negative';
172 tryeq $T++, $s, -4294967290, '-= with negative';
175 tryeq $T++, $s, -4294967297, '-= with positive';
178 tryeq $T++, $s, +4294967297, '-= with positive';
181 tryeq $T++, 1 * 3, 3, 'multiplication of two positive integers';
182 tryeq $T++, -2 * 3, -6, 'multiplication of negative and positive integer';
183 tryeq $T++, 3 * -3, -9, 'multiplication of positive and negative integer';
184 tryeq $T++, -4 * -3, 12, 'multiplication of two negative integers';
186 # check with 0xFFFF and 0xFFFF
187 tryeq $T++, 65535 * 65535, 4294836225,
188 'multiplication: 0xFFFF and 0xFFFF: pos pos';
189 tryeq $T++, 65535 * -65535, -4294836225,
190 'multiplication: 0xFFFF and 0xFFFF: pos neg';
191 tryeq $T++, -65535 * 65535, -4294836225,
192 'multiplication: 0xFFFF and 0xFFFF: pos neg';
193 tryeq $T++, -65535 * -65535, 4294836225,
194 'multiplication: 0xFFFF and 0xFFFF: neg neg';
196 # check with 0xFFFF and 0x10001
197 tryeq $T++, 65535 * 65537, 4294967295,
198 'multiplication: 0xFFFF and 0x10001: pos pos';
199 tryeq $T++, 65535 * -65537, -4294967295,
200 'multiplication: 0xFFFF and 0x10001: pos neg';
201 tryeq $T++, -65535 * 65537, -4294967295,
202 'multiplication: 0xFFFF and 0x10001: neg pos';
203 tryeq $T++, -65535 * -65537, 4294967295,
204 'multiplication: 0xFFFF and 0x10001: neg neg';
206 # check with 0x10001 and 0xFFFF
207 tryeq $T++, 65537 * 65535, 4294967295,
208 'multiplication: 0x10001 and 0xFFFF: pos pos';
209 tryeq $T++, 65537 * -65535, -4294967295,
210 'multiplication: 0x10001 and 0xFFFF: pos neg';
211 tryeq $T++, -65537 * 65535, -4294967295,
212 'multiplication: 0x10001 and 0xFFFF: neg pos';
213 tryeq $T++, -65537 * -65535, 4294967295,
214 'multiplication: 0x10001 and 0xFFFF: neg neg';
216 # These should all be dones as NVs
217 tryeq $T++, 65537 * 65537, 4295098369, 'multiplication: NV: pos pos';
218 tryeq $T++, 65537 * -65537, -4295098369, 'multiplication: NV: pos neg';
219 tryeq $T++, -65537 * 65537, -4295098369, 'multiplication: NV: neg pos';
220 tryeq $T++, -65537 * -65537, 4295098369, 'multiplication: NV: neg neg';
222 # will overflow an IV (in 32-bit)
223 tryeq $T++, 46340 * 46342, 0x80001218,
224 'multiplication: overflow an IV in 32-bit: pos pos';
225 tryeq $T++, 46340 * -46342, -0x80001218,
226 'multiplication: overflow an IV in 32-bit: pos neg';
227 tryeq $T++, -46340 * 46342, -0x80001218,
228 'multiplication: overflow an IV in 32-bit: neg pos';
229 tryeq $T++, -46340 * -46342, 0x80001218,
230 'multiplication: overflow an IV in 32-bit: neg neg';
232 tryeq $T++, 46342 * 46340, 0x80001218,
233 'multiplication: overflow an IV in 32-bit: pos pos';
234 tryeq $T++, 46342 * -46340, -0x80001218,
235 'multiplication: overflow an IV in 32-bit: pos neg';
236 tryeq $T++, -46342 * 46340, -0x80001218,
237 'multiplication: overflow an IV in 32-bit: neg pos';
238 tryeq $T++, -46342 * -46340, 0x80001218,
239 'multiplication: overflow an IV in 32-bit: neg neg';
241 # will overflow a positive IV (in 32-bit)
242 tryeq $T++, 65536 * 32768, 0x80000000,
243 'multiplication: overflow a positive IV in 32-bit: pos pos';
244 tryeq $T++, 65536 * -32768, -0x80000000,
245 'multiplication: overflow a positive IV in 32-bit: pos neg';
246 tryeq $T++, -65536 * 32768, -0x80000000,
247 'multiplication: overflow a positive IV in 32-bit: neg pos';
248 tryeq $T++, -65536 * -32768, 0x80000000,
249 'multiplication: overflow a positive IV in 32-bit: neg neg';
251 tryeq $T++, 32768 * 65536, 0x80000000,
252 'multiplication: overflow a positive IV in 32-bit: pos pos';
253 tryeq $T++, 32768 * -65536, -0x80000000,
254 'multiplication: overflow a positive IV in 32-bit: pos neg';
255 tryeq $T++, -32768 * 65536, -0x80000000,
256 'multiplication: overflow a positive IV in 32-bit: neg pos';
257 tryeq $T++, -32768 * -65536, 0x80000000,
258 'multiplication: overflow a positive IV in 32-bit: neg neg';
260 # 2147483647 is prime. bah.
262 tryeq $T++, 46339 * 46341, 0x7ffea80f,
263 'multiplication: hex product: pos pos';
264 tryeq $T++, 46339 * -46341, -0x7ffea80f,
265 'multiplication: hex product: pos neg';
266 tryeq $T++, -46339 * 46341, -0x7ffea80f,
267 'multiplication: hex product: neg pos';
268 tryeq $T++, -46339 * -46341, 0x7ffea80f,
269 'multiplication: hex product: neg neg';
271 # leading space should be ignored
273 tryeq $T++, 1 + " 1", 2, 'ignore leading space: addition';
274 tryeq $T++, 3 + " -1", 2, 'ignore leading space: subtraction';
275 tryeq $T++, 1.2, " 1.2", 'floating point and string equivalent: positive';
276 tryeq $T++, -1.2, " -1.2", 'floating point and string equivalent: negative';
279 tryeq $T++, 28/14, 2, 'division of two positive integers';
280 tryeq $T++, 28/-7, -4, 'division of positive integer by negative';
281 tryeq $T++, -28/4, -7, 'division of negative integer by positive';
282 tryeq $T++, -28/-2, 14, 'division of negative integer by negative';
284 tryeq $T++, 0x80000000/1, 0x80000000,
285 'division of positive hex by positive integer';
286 tryeq $T++, 0x80000000/-1, -0x80000000,
287 'division of positive hex by negative integer';
288 tryeq $T++, -0x80000000/1, -0x80000000,
289 'division of negative hex by negative integer';
290 tryeq $T++, -0x80000000/-1, 0x80000000,
291 'division of negative hex by positive integer';
293 # The example for sloppy divide, rigged to avoid the peephole optimiser.
294 tryeq_sloppy $T++, "20." / "5.", 4, 'division of floating point without fractional part';
296 tryeq $T++, 2.5 / 2, 1.25,
297 'division of positive floating point by positive integer';
298 tryeq $T++, 3.5 / -2, -1.75,
299 'division of positive floating point by negative integer';
300 tryeq $T++, -4.5 / 2, -2.25,
301 'division of negative floating point by positive integer';
302 tryeq $T++, -5.5 / -2, 2.75,
303 'division of negative floating point by negative integer';
305 # Bluuurg if your floating point can not accurately cope with powers of 2
306 # [I suspect this is parsing string->float problems, not actual arith]
307 tryeq_sloppy $T++, 18446744073709551616/1, 18446744073709551616,
308 'division of very large number by 1'; # Bluuurg
309 tryeq_sloppy $T++, 18446744073709551616/2, 9223372036854775808,
310 'division of very large number by 2';
311 tryeq_sloppy $T++, 18446744073709551616/4294967296, 4294967296,
312 'division of two very large numbers';
313 tryeq_sloppy $T++, 18446744073709551616/9223372036854775808, 2,
314 'division of two very large numbers';
317 # The peephole optimiser is wrong to think that it can substitute intops
318 # in place of regular ops, because i_multiply can overflow.
319 # Bug reported by "Sisyphus" <kalinabears@hdc.com.au>
322 my $float = ($n % 1000) * 167772160.0;
323 tryeq_sloppy $T++, $float, 21307064320, 'integer times floating point';
325 # On a 32 bit machine, if the i_multiply op is used, you will probably get
326 # -167772160. It is actually undefined behaviour, so anything may happen.
327 my $int = ($n % 1000) * 167772160;
328 tryeq $T++, $int, 21307064320, 'integer times integer';
330 my $float2 = ($n % 1000 + 0.0) * 167772160;
331 tryeq $T++, $float2, 21307064320, 'floating point times integer';
333 my $int2 = ($n % 1000 + 0) * 167772160;
334 tryeq $T++, $int2, 21307064320, 'integer plus zero times integer';
336 # zero, but in a way that ought to be able to defeat any future optimizer:
338 my $int3 = ($n % 1000 + $zero) * 167772160;
339 tryeq $T++, $int3, 21307064320, 'defeat any future optimizer';
342 my $t1000 = time() * 1000;
343 try $T++, abs($t1000 -1000 * $t) <= 2000, 'absolute value';
350 my $float = ($n % 1000) * 720575940379279360.0;
351 tryeq_sloppy $T++, $float, 9.15131444281685e+19,
352 '64 bit: integer times floating point';
354 my $int = ($n % 1000) * 720575940379279360;
355 tryeq_sloppy $T++, $int, 9.15131444281685e+19,
356 '64 bit: integer times integer';
358 my $float2 = ($n % 1000 + 0.0) * 720575940379279360;
359 tryeq_sloppy $T++, $float2, 9.15131444281685e+19,
360 '64 bit: floating point times integer';
362 my $int2 = ($n % 1000 + 0) * 720575940379279360;
363 tryeq_sloppy $T++, $int2, 9.15131444281685e+19,
364 '64 bit: integer plus zero times integer';
366 # zero, but in a way that ought to be able to defeat any future optimizer:
368 my $int3 = ($n % 1000 + $zero) * 720575940379279360;
369 tryeq_sloppy $T++, $int3, 9.15131444281685e+19,
370 '64 bit: defeat any future optimizer';
373 # [perl #109542] $1 and "$1" should be treated the same way
374 "976562500000000" =~ /(\d+)/;
377 print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" * something\n';
380 print "not "x($a ne $b), "ok ", $T++, qq ' - something * \$1 vs "\$1"\n';
381 $a = ($1 + 102400000000000);
382 $b = ("$1" + 102400000000000);
383 print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" + something\n';
384 $a = (102400000000000 + $1);
385 $b = (102400000000000 + "$1");
386 print "not "x($a ne $b), "ok ", $T++, qq ' - something + \$1 vs "\$1"\n';
387 $a = ($1 - 10240000000000000);
388 $b = ("$1" - 10240000000000000);
389 print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" - something\n';
390 $a = (10240000000000000 - $1);
391 $b = (10240000000000000 - "$1");
392 print "not "x($a ne $b), "ok ", $T++, qq ' - something - \$1 vs "\$1"\n';
393 "976562500" =~ /(\d+)/;
396 print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" ** something\n';
400 print "not "x($a ne $b), "ok ", $T++, qq ' - something ** \$1 vs "\$1"\n';
401 "97656250000000000" =~ /(\d+)/;
404 print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" / something\n';
406 $a = (97656250000000000 / $1);
407 $b = (97656250000000000 / "$1");
408 print "not "x($a ne $b), "ok ", $T++, qq ' - something / \$1 vs "\$1"\n';
409 "97656250000000000" =~ /(\d+)/;
410 $a = ($1 <=> 97656250000000001);
411 $b = ("$1" <=> 97656250000000001);
412 print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" <=> something\n';
413 $a = (97656250000000001 <=> $1);
414 $b = (97656250000000001 <=> "$1");
415 print "not "x($a ne $b), "ok ", $T++, qq ' - something <=> \$1 vs "\$1"\n';
416 "97656250000000001" =~ /(\d+)/;
417 $a = ($1 % 97656250000000002);
418 $b = ("$1" % 97656250000000002);
419 print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" % something\n';
420 $a = (97656250000000000 % $1);
421 $b = (97656250000000000 % "$1");
422 print "not "x($a ne $b), "ok ", $T++, qq ' - something % \$1 vs "\$1"\n';
426 eval { require Config };
427 $vms_no_ieee = 1 unless defined($Config::Config{useieee});
431 print "not ok ", $T++, " # TODO VOS raises SIGFPE instead of producing infinity.\n";
433 elsif ($vms_no_ieee || !$Config{d_double_has_inf}) {
434 print "ok ", $T++, " # SKIP -- the IEEE infinity model is unavailable in this configuration.\n"
436 elsif ($^O eq 'ultrix') {
437 print "not ok ", $T++, " # TODO Ultrix enters deep nirvana instead of producing infinity.\n";
440 # The computation of $v should overflow and produce "infinity"
441 # on any system whose max exponent is less than 10**1506.
442 # The exact string used to represent infinity varies by OS,
443 # so we don't test for it; all we care is that we don't die.
445 # Perl considers it to be an error if SIGFPE is raised.
446 # Chances are the interpreter will die, since it doesn't set
447 # up a handler for SIGFPE. That's why this test is last; to
448 # minimize the number of test failures. --PG
456 print "ok ", $T++, " - infinity\n";
461 # small numbers shouldn't round to zero if they have extra floating digits
463 unless ($Config{d_double_style_ieee}) {
464 for (1..8) { print "ok ", $T++, " # SKIP -- not IEEE\n" }
466 try $T++, 0.153e-305 != 0.0, '0.153e-305';
467 try $T++, 0.1530e-305 != 0.0, '0.1530e-305';
468 try $T++, 0.15300e-305 != 0.0, '0.15300e-305';
469 try $T++, 0.153000e-305 != 0.0, '0.153000e-305';
470 try $T++, 0.1530000e-305 != 0.0, '0.1530000e-305';
471 try $T++, 0.1530001e-305 != 0.0, '0.1530001e-305';
472 try $T++, 1.17549435100e-38 != 0.0, 'min single';
473 # For flush-to-zero systems this may flush-to-zero, see PERL_SYS_FPU_INIT
474 try $T++, 2.2250738585072014e-308 != 0.0, 'min double';
477 # string-to-nv should equal float literals
478 try $T++, "1.23" + 0 == 1.23, '1.23';
479 try $T++, " 1.23" + 0 == 1.23, '1.23 with leading space';
480 try $T++, "1.23 " + 0 == 1.23, '1.23 with trailing space';
481 try $T++, "+1.23" + 0 == 1.23, '1.23 with unary plus';
482 try $T++, "-1.23" + 0 == -1.23, '1.23 with unary minus';
483 try $T++, "1.23e4" + 0 == 12300, '1.23e4';
485 # trigger various attempts to negate IV_MIN
487 tryeq $T++, 0x80000000 / -0x80000000, -1, '(IV_MAX+1) / IV_MIN';
488 tryeq $T++, -0x80000000 / 0x80000000, -1, 'IV_MIN / (IV_MAX+1)';
489 tryeq $T++, 0x80000000 / -1, -0x80000000, '(IV_MAX+1) / -1';
490 tryeq $T++, 0 % -0x80000000, 0, '0 % IV_MIN';
491 tryeq $T++, -0x80000000 % -0x80000000, 0, 'IV_MIN % IV_MIN';