1#!./perl -w
2
3# This file has been placed in t/opbasic to indicate that it should not use
4# functions imported from t/test.pl or Test::More, as those programs/libraries
5# use operators which are what is being tested in this file.
6
7print "1..180\n";
8
9sub try ($$$) {
10   print +($_[1] ? "ok" : "not ok") . " $_[0] - $_[2]\n";
11}
12sub tryeq ($$$$) {
13  my $status;
14  if ($_[1] == $_[2]) {
15    $status = "ok $_[0]";
16  } else {
17    $status = "not ok $_[0] # $_[1] != $_[2]";
18  }
19  print "$status - $_[3]\n";
20}
21sub tryeq_sloppy ($$$$) {
22  my $status;
23  if ($_[1] == $_[2]) {
24    $status = "ok $_[0]";
25  } else {
26    my $error = abs (($_[1] - $_[2]) / $_[1]);
27    if ($error < 1e-9) {
28      $status = "ok $_[0] # $_[1] is close to $_[2], \$^O eq $^O";
29    } else {
30      $status = "not ok $_[0] # $_[1] != $_[2]";
31    }
32  }
33  print "$status - $_[3]\n";
34}
35
36my $T = 1;
37tryeq $T++,  13 %  4, 1, 'modulo: positive positive';
38tryeq $T++, -13 %  4, 3, 'modulo: negative positive';
39tryeq $T++,  13 % -4, -3, 'modulo: positive negative';
40tryeq $T++, -13 % -4, -1, 'modulo: negative negative';
41
42# Exercise some of the dright/dleft logic in pp_modulo
43
44tryeq $T++, 13.333333 % 5.333333, 3, 'modulo: 13.333333 % 5.333333';
45tryeq $T++, 13.333333 % 5,        3, 'modulo: 13.333333 % 5';
46tryeq $T++, 13 % 5.333333,        3, 'modulo: 13 % 5.333333';
47
48# Give abs() a good work-out before using it in anger
49tryeq $T++, abs(0), 0, 'abs(): 0 0';
50tryeq $T++, abs(1), 1, 'abs(): 1 1';
51tryeq $T++, abs(-1), 1, 'abs(): -1 1';
52tryeq $T++, abs(2147483647), 2147483647, 'abs(): 2**31-1: pos pos';
53tryeq $T++, abs(-2147483647), 2147483647, 'abs(): 2**31-1: neg pos';
54tryeq $T++, abs(4294967295), 4294967295, 'abs(): 2**32-1: pos pos';
55tryeq $T++, abs(-4294967295), 4294967295, 'abs(): 2**32-1: neg pos';
56tryeq $T++, abs(9223372036854775807), 9223372036854775807,
57    'abs(): 2**63-1: pos pos';
58tryeq $T++, abs(-9223372036854775807), 9223372036854775807,
59    'abs(): 2**63-1: neg pos';
60# Assume no change whatever; no slop needed
61tryeq $T++, abs(1e50), 1e50, 'abs(): 1e50: pos pos';
62# Assume only sign bit flipped
63tryeq $T++, abs(-1e50), 1e50, 'abs(): 1e50: neg pos';
64
65my $limit = 1e6;
66
67# Division (and modulo) of floating point numbers
68# seem to be rather sloppy in Cray.
69$limit = 1e8 if $^O eq 'unicos';
70
71try $T++, abs( 13e21 %  4e21 -  1e21) < $limit, 'abs() for floating point';
72try $T++, abs(-13e21 %  4e21 -  3e21) < $limit, 'abs() for floating point';
73try $T++, abs( 13e21 % -4e21 - -3e21) < $limit, 'abs() for floating point';
74try $T++, abs(-13e21 % -4e21 - -1e21) < $limit, 'abs() for floating point';
75
76tryeq $T++, 4063328477 % 65535, 27407, 'UV behaves properly: modulo';
77tryeq $T++, 4063328477 % 4063328476, 1, 'UV behaves properly: modulo';
78tryeq $T++, 4063328477 % 2031664238, 1, 'UV behaves properly: modulo';
79tryeq $T++, 2031664238 % 4063328477, 2031664238,
80    'UV behaves properly: modulo';
81
82tryeq $T++, 2147483647 + 0, 2147483647,
83    'trigger wrapping on 32 bit IVs and UVs';
84
85tryeq $T++, 2147483647 + 1, 2147483648, 'IV + IV promotes to UV';
86tryeq $T++, 2147483640 + 10, 2147483650, 'IV + IV promotes to UV';
87tryeq $T++, 2147483647 + 2147483647, 4294967294, 'IV + IV promotes to UV';
88tryeq $T++, 2147483647 + 2147483649, 4294967296, 'IV + UV promotes to NV';
89tryeq $T++, 4294967294 + 2, 4294967296, 'UV + IV promotes to NV';
90tryeq $T++, 4294967295 + 4294967295, 8589934590, 'UV + UV promotes to NV';
91
92tryeq $T++, 2147483648 + -1, 2147483647, 'UV + IV promotes to IV';
93tryeq $T++, 2147483650 + -10, 2147483640, 'UV + IV promotes to IV';
94tryeq $T++, -1 + 2147483648, 2147483647, 'IV + UV promotes to IV';
95tryeq $T++, -10 + 4294967294, 4294967284, 'IV + UV promotes to IV';
96tryeq $T++, -2147483648 + -2147483648, -4294967296, 'IV + IV promotes to NV';
97tryeq $T++, -2147483640 + -10, -2147483650, 'IV + IV promotes to NV';
98
99# Hmm. Do not forget the simple stuff
100# addition
101tryeq $T++, 1 + 1, 2, 'addition of 2 positive integers';
102tryeq $T++, 4 + -2, 2, 'addition of positive and negative integer';
103tryeq $T++, -10 + 100, 90, 'addition of negative and positive integer';
104tryeq $T++, -7 + -9, -16, 'addition of 2 negative integers';
105tryeq $T++, -63 + +2, -61, 'addition of signed negative and positive integers';
106tryeq $T++, 4 + -1, 3, 'addition of positive and negative integer';
107tryeq $T++, -1 + 1, 0, 'addition which sums to 0';
108tryeq $T++, +29 + -29, 0, 'addition which sums to 0';
109tryeq $T++, -1 + 4, 3, 'addition of signed negative and positive integers';
110tryeq $T++, +4 + -17, -13, 'addition of signed positive and negative integers';
111
112# subtraction
113tryeq $T++, 3 - 1, 2, 'subtraction of two positive integers';
114tryeq $T++, 3 - 15, -12,
115    'subtraction of two positive integers: minuend smaller';
116tryeq $T++, 3 - -7, 10, 'subtraction of positive and negative integer';
117tryeq $T++, -156 - 5, -161, 'subtraction of negative and positive integer';
118tryeq $T++, -156 - -5, -151, 'subtraction of two negative integers';
119tryeq $T++, -5 - -12, 7,
120    'subtraction of two negative integers: minuend smaller';
121tryeq $T++, -3 - -3, 0, 'subtraction of two negative integers with result of 0';
122tryeq $T++, 15 - 15, 0, 'subtraction of two positive integers with result of 0';
123tryeq $T++, 2147483647 - 0, 2147483647, 'subtraction from large integer';
124tryeq $T++, 2147483648 - 0, 2147483648, 'subtraction from large integer';
125tryeq $T++, -2147483648 - 0, -2147483648,
126    'subtraction from large negative integer';
127tryeq $T++, 0 - -2147483647, 2147483647,
128    'subtraction of large negative integer from 0';
129tryeq $T++, -1 - -2147483648, 2147483647,
130    'subtraction of large negative integer from negative integer';
131tryeq $T++, 2 - -2147483648, 2147483650,
132    'subtraction of large negative integer from positive integer';
133tryeq $T++, 4294967294 - 3, 4294967291, 'subtraction from large integer';
134tryeq $T++, -2147483648 - -1, -2147483647,
135    'subtraction from large negative integer';
136tryeq $T++, 2147483647 - -1, 2147483648, 'IV - IV promote to UV';
137tryeq $T++, 2147483647 - -2147483648, 4294967295, 'IV - IV promote to UV';
138tryeq $T++, 4294967294 - -3, 4294967297, 'UV - IV promote to NV';
139tryeq $T++, -2147483648 - +1, -2147483649, 'IV - IV promote to NV';
140tryeq $T++, 2147483648 - 2147483650, -2, 'UV - UV promote to IV';
141tryeq $T++, 2000000000 - 4000000000, -2000000000, 'IV - UV promote to IV';
142
143# No warnings should appear;
144my $a;
145$a += 1;
146tryeq $T++, $a, 1, '+= with positive';
147undef $a;
148$a += -1;
149tryeq $T++, $a, -1, '+= with negative';
150undef $a;
151$a += 4294967290;
152tryeq $T++, $a, 4294967290, '+= with positive';
153undef $a;
154$a += -4294967290;
155tryeq $T++, $a, -4294967290, '+= with negative';
156undef $a;
157$a += 4294967297;
158tryeq $T++, $a, 4294967297, '+= with positive';
159undef $a;
160$a += -4294967297;
161tryeq $T++, $a, -4294967297, '+= with negative';
162
163my $s;
164$s -= 1;
165tryeq $T++, $s, -1, '-= with positive';
166undef $s;
167$s -= -1;
168tryeq $T++, $s, +1, '-= with negative';
169undef $s;
170$s -= -4294967290;
171tryeq $T++, $s, +4294967290, '-= with negative';
172undef $s;
173$s -= 4294967290;
174tryeq $T++, $s, -4294967290, '-= with negative';
175undef $s;
176$s -= 4294967297;
177tryeq $T++, $s, -4294967297, '-= with positive';
178undef $s;
179$s -= -4294967297;
180tryeq $T++, $s, +4294967297, '-= with positive';
181
182# multiplication
183tryeq $T++, 1 * 3, 3, 'multiplication of two positive integers';
184tryeq $T++, -2 * 3, -6, 'multiplication of negative and positive integer';
185tryeq $T++, 3 * -3, -9, 'multiplication of positive and negative integer';
186tryeq $T++, -4 * -3, 12, 'multiplication of two negative integers';
187
188# check with 0xFFFF and 0xFFFF
189tryeq $T++, 65535 * 65535, 4294836225,
190    'multiplication: 0xFFFF and 0xFFFF: pos pos';
191tryeq $T++, 65535 * -65535, -4294836225,
192    'multiplication: 0xFFFF and 0xFFFF: pos neg';
193tryeq $T++, -65535 * 65535, -4294836225,
194    'multiplication: 0xFFFF and 0xFFFF: pos neg';
195tryeq $T++, -65535 * -65535, 4294836225,
196    'multiplication: 0xFFFF and 0xFFFF: neg neg';
197
198# check with 0xFFFF and 0x10001
199tryeq $T++, 65535 * 65537, 4294967295,
200    'multiplication: 0xFFFF and 0x10001: pos pos';
201tryeq $T++, 65535 * -65537, -4294967295,
202    'multiplication: 0xFFFF and 0x10001: pos neg';
203tryeq $T++, -65535 * 65537, -4294967295,
204    'multiplication: 0xFFFF and 0x10001: neg pos';
205tryeq $T++, -65535 * -65537, 4294967295,
206    'multiplication: 0xFFFF and 0x10001: neg neg';
207
208# check with 0x10001 and 0xFFFF
209tryeq $T++, 65537 * 65535, 4294967295,
210    'multiplication: 0x10001 and 0xFFFF: pos pos';
211tryeq $T++, 65537 * -65535, -4294967295,
212    'multiplication: 0x10001 and 0xFFFF: pos neg';
213tryeq $T++, -65537 * 65535, -4294967295,
214    'multiplication: 0x10001 and 0xFFFF: neg pos';
215tryeq $T++, -65537 * -65535, 4294967295,
216    'multiplication: 0x10001 and 0xFFFF: neg neg';
217
218# These should all be dones as NVs
219tryeq $T++, 65537 * 65537, 4295098369, 'multiplication: NV: pos pos';
220tryeq $T++, 65537 * -65537, -4295098369, 'multiplication: NV: pos neg';
221tryeq $T++, -65537 * 65537, -4295098369, 'multiplication: NV: neg pos';
222tryeq $T++, -65537 * -65537, 4295098369, 'multiplication: NV: neg neg';
223
224# will overflow an IV (in 32-bit)
225tryeq $T++, 46340 * 46342, 0x80001218,
226    'multiplication: overflow an IV in 32-bit: pos pos';
227tryeq $T++, 46340 * -46342, -0x80001218,
228    'multiplication: overflow an IV in 32-bit: pos neg';
229tryeq $T++, -46340 * 46342, -0x80001218,
230    'multiplication: overflow an IV in 32-bit: neg pos';
231tryeq $T++, -46340 * -46342, 0x80001218,
232    'multiplication: overflow an IV in 32-bit: neg neg';
233
234tryeq $T++, 46342 * 46340, 0x80001218,
235    'multiplication: overflow an IV in 32-bit: pos pos';
236tryeq $T++, 46342 * -46340, -0x80001218,
237    'multiplication: overflow an IV in 32-bit: pos neg';
238tryeq $T++, -46342 * 46340, -0x80001218,
239    'multiplication: overflow an IV in 32-bit: neg pos';
240tryeq $T++, -46342 * -46340, 0x80001218,
241    'multiplication: overflow an IV in 32-bit: neg neg';
242
243# will overflow a positive IV (in 32-bit)
244tryeq $T++, 65536 * 32768, 0x80000000,
245    'multiplication: overflow a positive IV in 32-bit: pos pos';
246tryeq $T++, 65536 * -32768, -0x80000000,
247    'multiplication: overflow a positive IV in 32-bit: pos neg';
248tryeq $T++, -65536 * 32768, -0x80000000,
249    'multiplication: overflow a positive IV in 32-bit: neg pos';
250tryeq $T++, -65536 * -32768, 0x80000000,
251    'multiplication: overflow a positive IV in 32-bit: neg neg';
252
253tryeq $T++, 32768 * 65536, 0x80000000,
254    'multiplication: overflow a positive IV in 32-bit: pos pos';
255tryeq $T++, 32768 * -65536, -0x80000000,
256    'multiplication: overflow a positive IV in 32-bit: pos neg';
257tryeq $T++, -32768 * 65536, -0x80000000,
258    'multiplication: overflow a positive IV in 32-bit: neg pos';
259tryeq $T++, -32768 * -65536, 0x80000000,
260    'multiplication: overflow a positive IV in 32-bit: neg neg';
261
262# 2147483647 is prime. bah.
263
264tryeq $T++, 46339 * 46341, 0x7ffea80f,
265    'multiplication: hex product: pos pos';
266tryeq $T++, 46339 * -46341, -0x7ffea80f,
267    'multiplication: hex product: pos neg';
268tryeq $T++, -46339 * 46341, -0x7ffea80f,
269    'multiplication: hex product: neg pos';
270tryeq $T++, -46339 * -46341, 0x7ffea80f,
271    'multiplication: hex product: neg neg';
272
273# leading space should be ignored
274
275tryeq $T++, 1 + " 1", 2, 'ignore leading space: addition';
276tryeq $T++, 3 + " -1", 2, 'ignore leading space: subtraction';
277tryeq $T++, 1.2, " 1.2", 'floating point and string equivalent: positive';
278tryeq $T++, -1.2, " -1.2", 'floating point and string equivalent: negative';
279
280# division
281tryeq $T++, 28/14, 2, 'division of two positive integers';
282tryeq $T++, 28/-7, -4, 'division of positive integer by negative';
283tryeq $T++, -28/4, -7, 'division of negative integer by positive';
284tryeq $T++, -28/-2, 14, 'division of negative integer by negative';
285
286tryeq $T++, 0x80000000/1, 0x80000000,
287    'division of positive hex by positive integer';
288tryeq $T++, 0x80000000/-1, -0x80000000,
289    'division of positive hex by negative integer';
290tryeq $T++, -0x80000000/1, -0x80000000,
291    'division of negative hex by negative integer';
292tryeq $T++, -0x80000000/-1, 0x80000000,
293    'division of negative hex by positive integer';
294
295# The example for sloppy divide, rigged to avoid the peephole optimiser.
296tryeq_sloppy $T++, "20." / "5.", 4, 'division of floating point without fractional part';
297
298tryeq $T++, 2.5 / 2, 1.25,
299    'division of positive floating point by positive integer';
300tryeq $T++, 3.5 / -2, -1.75,
301    'division of positive floating point by negative integer';
302tryeq $T++, -4.5 / 2, -2.25,
303    'division of negative floating point by positive integer';
304tryeq $T++, -5.5 / -2, 2.75,
305    'division of negative floating point by negative integer';
306
307# Bluuurg if your floating point can not accurately cope with powers of 2
308# [I suspect this is parsing string->float problems, not actual arith]
309tryeq_sloppy $T++, 18446744073709551616/1, 18446744073709551616,
310    'division of very large number by 1'; # Bluuurg
311tryeq_sloppy $T++, 18446744073709551616/2, 9223372036854775808,
312    'division of very large number by 2';
313tryeq_sloppy $T++, 18446744073709551616/4294967296, 4294967296,
314    'division of two very large numbers';
315tryeq_sloppy $T++, 18446744073709551616/9223372036854775808, 2,
316    'division of two very large numbers';
317
318{
319  # The peephole optimiser is wrong to think that it can substitute intops
320  # in place of regular ops, because i_multiply can overflow.
321  # Bug reported by "Sisyphus" <kalinabears@hdc.com.au>
322  my $n = 1127;
323
324  my $float = ($n % 1000) * 167772160.0;
325  tryeq_sloppy $T++, $float, 21307064320, 'integer times floating point';
326
327  # On a 32 bit machine, if the i_multiply op is used, you will probably get
328  # -167772160. It is actually undefined behaviour, so anything may happen.
329  my $int = ($n % 1000) * 167772160;
330  tryeq $T++, $int, 21307064320, 'integer times integer';
331
332  my $float2 = ($n % 1000 + 0.0) * 167772160;
333  tryeq $T++, $float2, 21307064320, 'floating point times integer';
334
335  my $int2 = ($n % 1000 + 0) * 167772160;
336  tryeq $T++, $int2, 21307064320, 'integer plus zero times integer';
337
338  # zero, but in a way that ought to be able to defeat any future optimizer:
339  my $zero = $$ - $$;
340  my $int3 = ($n % 1000 + $zero) * 167772160;
341  tryeq $T++, $int3, 21307064320, 'defeat any future optimizer';
342
343  my $t = time;
344  my $t1000 = time() * 1000;
345  try $T++, abs($t1000 -1000 * $t) <= 2000, 'absolute value';
346}
347
348{
349  # 64 bit variants
350  my $n = 1127;
351
352  my $float = ($n % 1000) * 720575940379279360.0;
353  tryeq_sloppy $T++, $float, 9.15131444281685e+19,
354    '64 bit: integer times floating point';
355
356  my $int = ($n % 1000) * 720575940379279360;
357  tryeq_sloppy $T++, $int, 9.15131444281685e+19,
358    '64 bit: integer times integer';
359
360  my $float2 = ($n % 1000 + 0.0) * 720575940379279360;
361  tryeq_sloppy $T++, $float2, 9.15131444281685e+19,
362    '64 bit: floating point times integer';
363
364  my $int2 = ($n % 1000 + 0) * 720575940379279360;
365  tryeq_sloppy $T++, $int2, 9.15131444281685e+19,
366    '64 bit: integer plus zero times integer';
367
368  # zero, but in a way that ought to be able to defeat any future optimizer:
369  my $zero = $$ - $$;
370  my $int3 = ($n % 1000 + $zero) * 720575940379279360;
371  tryeq_sloppy $T++, $int3, 9.15131444281685e+19,
372    '64 bit: defeat any future optimizer';
373}
374
375# [perl #109542] $1 and "$1" should be treated the same way
376"976562500000000" =~ /(\d+)/;
377$a = ($1 * 1024);
378$b = ("$1" * 1024);
379print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" * something\n';
380$a = (1024 * $1);
381$b = (1024 * "$1");
382print "not "x($a ne $b), "ok ", $T++, qq ' - something * \$1 vs "\$1"\n';
383$a = ($1 + 102400000000000);
384$b = ("$1" + 102400000000000);
385print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" + something\n';
386$a = (102400000000000 + $1);
387$b = (102400000000000 + "$1");
388print "not "x($a ne $b), "ok ", $T++, qq ' - something + \$1 vs "\$1"\n';
389$a = ($1 - 10240000000000000);
390$b = ("$1" - 10240000000000000);
391print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" - something\n';
392$a = (10240000000000000 - $1);
393$b = (10240000000000000 - "$1");
394print "not "x($a ne $b), "ok ", $T++, qq ' - something - \$1 vs "\$1"\n';
395"976562500" =~ /(\d+)/;
396$a = ($1 ** 2);
397$b = ("$1" ** 2);
398print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" ** something\n';
399"32" =~ /(\d+)/;
400$a = (3 ** $1);
401$b = (3 ** "$1");
402print "not "x($a ne $b), "ok ", $T++, qq ' - something ** \$1 vs "\$1"\n';
403"97656250000000000" =~ /(\d+)/;
404$a = ($1 / 10);
405$b = ("$1" / 10);
406print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" / something\n';
407"10" =~ /(\d+)/;
408$a = (97656250000000000 / $1);
409$b = (97656250000000000 / "$1");
410print "not "x($a ne $b), "ok ", $T++, qq ' - something / \$1 vs "\$1"\n';
411"97656250000000000" =~ /(\d+)/;
412$a = ($1 <=> 97656250000000001);
413$b = ("$1" <=> 97656250000000001);
414print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" <=> something\n';
415$a = (97656250000000001 <=> $1);
416$b = (97656250000000001 <=> "$1");
417print "not "x($a ne $b), "ok ", $T++, qq ' - something <=> \$1 vs "\$1"\n';
418"97656250000000001" =~ /(\d+)/;
419$a = ($1 % 97656250000000002);
420$b = ("$1" % 97656250000000002);
421print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" % something\n';
422$a = (97656250000000000 % $1);
423$b = (97656250000000000 % "$1");
424print "not "x($a ne $b), "ok ", $T++, qq ' - something % \$1 vs "\$1"\n';
425
426# string-to-nv should equal float literals
427try $T++, "1.23"   + 0 ==  1.23,  '1.23';
428try $T++, " 1.23"  + 0 ==  1.23,  '1.23 with leading space';
429try $T++, "1.23 "  + 0 ==  1.23,  '1.23 with trailing space';
430try $T++, "+1.23"  + 0 ==  1.23,  '1.23 with unary plus';
431try $T++, "-1.23"  + 0 == -1.23,  '1.23 with unary minus';
432try $T++, "1.23e4" + 0 ==  12300, '1.23e4';
433
434# trigger various attempts to negate IV_MIN
435
436tryeq $T++,  0x80000000 / -0x80000000, -1, '(IV_MAX+1) / IV_MIN';
437tryeq $T++, -0x80000000 /  0x80000000, -1, 'IV_MIN / (IV_MAX+1)';
438tryeq $T++,  0x80000000 / -1, -0x80000000, '(IV_MAX+1) / -1';
439tryeq $T++,           0 % -0x80000000,  0, '0 % IV_MIN';
440tryeq $T++, -0x80000000 % -0x80000000,  0, 'IV_MIN % IV_MIN';
441