Small optimisations, by Brandon Black
[p5sagit/p5-mst-13.2.git] / t / op / arith.t
1 #!./perl -w
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6 }
7
8 print "1..145\n";
9
10 sub try ($$) {
11    print +($_[1] ? "ok" : "not ok"), " $_[0]\n";
12 }
13 sub tryeq ($$$) {
14   if ($_[1] == $_[2]) {
15     print "ok $_[0]\n";
16   } else {
17     print "not ok $_[0] # $_[1] != $_[2]\n";
18   }
19 }
20 sub tryeq_sloppy ($$$) {
21   if ($_[1] == $_[2]) {
22     print "ok $_[0]\n";
23   } else {
24     my $error = abs ($_[1] - $_[2]) / $_[1];
25     if ($error < 1e-9) {
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 }
32
33 my $T = 1;
34 tryeq $T++,  13 %  4, 1;
35 tryeq $T++, -13 %  4, 3;
36 tryeq $T++,  13 % -4, -3;
37 tryeq $T++, -13 % -4, -1;
38
39 # Give abs() a good work-out before using it in anger
40 tryeq $T++, abs(0), 0;
41 tryeq $T++, abs(1), 1;
42 tryeq $T++, abs(-1), 1;
43 tryeq $T++, abs(2147483647), 2147483647;
44 tryeq $T++, abs(-2147483647), 2147483647;
45 tryeq $T++, abs(4294967295), 4294967295;
46 tryeq $T++, abs(-4294967295), 4294967295;
47 tryeq $T++, abs(9223372036854775807), 9223372036854775807;
48 tryeq $T++, abs(-9223372036854775807), 9223372036854775807;
49 tryeq $T++, abs(1e50), 1e50;    # Assume no change whatever; no slop needed
50 tryeq $T++, abs(-1e50), 1e50;   # Assume only sign bit flipped
51
52 my $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
58 try $T++, abs( 13e21 %  4e21 -  1e21) < $limit;
59 try $T++, abs(-13e21 %  4e21 -  3e21) < $limit;
60 try $T++, abs( 13e21 % -4e21 - -3e21) < $limit;
61 try $T++, abs(-13e21 % -4e21 - -1e21) < $limit;
62
63 # UVs should behave properly
64
65 tryeq $T++, 4063328477 % 65535, 27407;
66 tryeq $T++, 4063328477 % 4063328476, 1;
67 tryeq $T++, 4063328477 % 2031664238, 1;
68 tryeq $T++, 2031664238 % 4063328477, 2031664238;
69
70 # These should trigger wrapping on 32 bit IVs and UVs
71
72 tryeq $T++, 2147483647 + 0, 2147483647;
73
74 # IV + IV promote to UV
75 tryeq $T++, 2147483647 + 1, 2147483648;
76 tryeq $T++, 2147483640 + 10, 2147483650;
77 tryeq $T++, 2147483647 + 2147483647, 4294967294;
78 # IV + UV promote to NV
79 tryeq $T++, 2147483647 + 2147483649, 4294967296;
80 # UV + IV promote to NV
81 tryeq $T++, 4294967294 + 2, 4294967296;
82 # UV + UV promote to NV
83 tryeq $T++, 4294967295 + 4294967295, 8589934590;
84
85 # UV + IV to IV
86 tryeq $T++, 2147483648 + -1, 2147483647;
87 tryeq $T++, 2147483650 + -10, 2147483640;
88 # IV + UV to IV
89 tryeq $T++, -1 + 2147483648, 2147483647;
90 tryeq $T++, -10 + 4294967294, 4294967284;
91 # IV + IV to NV
92 tryeq $T++, -2147483648 + -2147483648, -4294967296;
93 tryeq $T++, -2147483640 + -10, -2147483650;
94
95 # Hmm. Don't forget the simple stuff
96 tryeq $T++, 1 + 1, 2;
97 tryeq $T++, 4 + -2, 2;
98 tryeq $T++, -10 + 100, 90;
99 tryeq $T++, -7 + -9, -16;
100 tryeq $T++, -63 + +2, -61;
101 tryeq $T++, 4 + -1, 3;
102 tryeq $T++, -1 + 1, 0;
103 tryeq $T++, +29 + -29, 0;
104 tryeq $T++, -1 + 4, 3;
105 tryeq $T++, +4 + -17, -13;
106
107 # subtraction
108 tryeq $T++, 3 - 1, 2;
109 tryeq $T++, 3 - 15, -12;
110 tryeq $T++, 3 - -7, 10;
111 tryeq $T++, -156 - 5, -161;
112 tryeq $T++, -156 - -5, -151;
113 tryeq $T++, -5 - -12, 7;
114 tryeq $T++, -3 - -3, 0;
115 tryeq $T++, 15 - 15, 0;
116
117 tryeq $T++, 2147483647 - 0, 2147483647;
118 tryeq $T++, 2147483648 - 0, 2147483648;
119 tryeq $T++, -2147483648 - 0, -2147483648;
120
121 tryeq $T++, 0 - -2147483647, 2147483647;
122 tryeq $T++, -1 - -2147483648, 2147483647;
123 tryeq $T++, 2 - -2147483648, 2147483650;
124
125 tryeq $T++, 4294967294 - 3, 4294967291;
126 tryeq $T++, -2147483648 - -1, -2147483647;
127
128 # IV - IV promote to UV
129 tryeq $T++, 2147483647 - -1, 2147483648;
130 tryeq $T++, 2147483647 - -2147483648, 4294967295;
131 # UV - IV promote to NV
132 tryeq $T++, 4294967294 - -3, 4294967297;
133 # IV - IV promote to NV
134 tryeq $T++, -2147483648 - +1, -2147483649;
135 # UV - UV promote to IV
136 tryeq $T++, 2147483648 - 2147483650, -2;
137 # IV - UV promote to IV
138 tryeq $T++, 2000000000 - 4000000000, -2000000000;
139
140 # No warnings should appear;
141 my $a;
142 $a += 1;
143 tryeq $T++, $a, 1;
144 undef $a;
145 $a += -1;
146 tryeq $T++, $a, -1;
147 undef $a;
148 $a += 4294967290;
149 tryeq $T++, $a, 4294967290;
150 undef $a;
151 $a += -4294967290;
152 tryeq $T++, $a, -4294967290;
153 undef $a;
154 $a += 4294967297;
155 tryeq $T++, $a, 4294967297;
156 undef $a;
157 $a += -4294967297;
158 tryeq $T++, $a, -4294967297;
159
160 my $s;
161 $s -= 1;
162 tryeq $T++, $s, -1;
163 undef $s;
164 $s -= -1;
165 tryeq $T++, $s, +1;
166 undef $s;
167 $s -= -4294967290;
168 tryeq $T++, $s, +4294967290;
169 undef $s;
170 $s -= 4294967290;
171 tryeq $T++, $s, -4294967290;
172 undef $s;
173 $s -= 4294967297;
174 tryeq $T++, $s, -4294967297;
175 undef $s;
176 $s -= -4294967297;
177 tryeq $T++, $s, +4294967297;
178
179 # Multiplication
180
181 tryeq $T++, 1 * 3, 3;
182 tryeq $T++, -2 * 3, -6;
183 tryeq $T++, 3 * -3, -9;
184 tryeq $T++, -4 * -3, 12;
185
186 # check with 0xFFFF and 0xFFFF
187 tryeq $T++, 65535 * 65535, 4294836225;
188 tryeq $T++, 65535 * -65535, -4294836225;
189 tryeq $T++, -65535 * 65535, -4294836225;
190 tryeq $T++, -65535 * -65535, 4294836225;
191
192 # check with 0xFFFF and 0x10001
193 tryeq $T++, 65535 * 65537, 4294967295;
194 tryeq $T++, 65535 * -65537, -4294967295;
195 tryeq $T++, -65535 * 65537, -4294967295;
196 tryeq $T++, -65535 * -65537, 4294967295;
197
198 # check with 0x10001 and 0xFFFF
199 tryeq $T++, 65537 * 65535, 4294967295;
200 tryeq $T++, 65537 * -65535, -4294967295;
201 tryeq $T++, -65537 * 65535, -4294967295;
202 tryeq $T++, -65537 * -65535, 4294967295;
203
204 # These should all be dones as NVs
205 tryeq $T++, 65537 * 65537, 4295098369;
206 tryeq $T++, 65537 * -65537, -4295098369;
207 tryeq $T++, -65537 * 65537, -4295098369;
208 tryeq $T++, -65537 * -65537, 4295098369;
209
210 # will overflow an IV (in 32-bit)
211 tryeq $T++, 46340 * 46342, 0x80001218;
212 tryeq $T++, 46340 * -46342, -0x80001218;
213 tryeq $T++, -46340 * 46342, -0x80001218;
214 tryeq $T++, -46340 * -46342, 0x80001218;
215
216 tryeq $T++, 46342 * 46340, 0x80001218;
217 tryeq $T++, 46342 * -46340, -0x80001218;
218 tryeq $T++, -46342 * 46340, -0x80001218;
219 tryeq $T++, -46342 * -46340, 0x80001218;
220
221 # will overflow a positive IV (in 32-bit)
222 tryeq $T++, 65536 * 32768, 0x80000000;
223 tryeq $T++, 65536 * -32768, -0x80000000;
224 tryeq $T++, -65536 * 32768, -0x80000000;
225 tryeq $T++, -65536 * -32768, 0x80000000;
226
227 tryeq $T++, 32768 * 65536, 0x80000000;
228 tryeq $T++, 32768 * -65536, -0x80000000;
229 tryeq $T++, -32768 * 65536, -0x80000000;
230 tryeq $T++, -32768 * -65536, 0x80000000;
231
232 # 2147483647 is prime. bah.
233
234 tryeq $T++, 46339 * 46341, 0x7ffea80f;
235 tryeq $T++, 46339 * -46341, -0x7ffea80f;
236 tryeq $T++, -46339 * 46341, -0x7ffea80f;
237 tryeq $T++, -46339 * -46341, 0x7ffea80f;
238
239 # leading space should be ignored
240
241 tryeq $T++, 1 + " 1", 2;
242 tryeq $T++, 3 + " -1", 2;
243 tryeq $T++, 1.2, " 1.2";
244 tryeq $T++, -1.2, " -1.2";
245
246 # divide
247
248 tryeq $T++, 28/14, 2;
249 tryeq $T++, 28/-7, -4;
250 tryeq $T++, -28/4, -7;
251 tryeq $T++, -28/-2, 14;
252
253 tryeq $T++, 0x80000000/1, 0x80000000;
254 tryeq $T++, 0x80000000/-1, -0x80000000;
255 tryeq $T++, -0x80000000/1, -0x80000000;
256 tryeq $T++, -0x80000000/-1, 0x80000000;
257
258 # The example for sloppy divide, rigged to avoid the peephole optimiser.
259 tryeq_sloppy $T++, "20." / "5.", 4;
260
261 tryeq $T++, 2.5 / 2, 1.25;
262 tryeq $T++, 3.5 / -2, -1.75;
263 tryeq $T++, -4.5 / 2, -2.25;
264 tryeq $T++, -5.5 / -2, 2.75;
265
266 # Bluuurg if your floating point can't accurately cope with powers of 2
267 # [I suspect this is parsing string->float problems, not actual arith]
268 tryeq_sloppy $T++, 18446744073709551616/1, 18446744073709551616; # Bluuurg
269 tryeq_sloppy $T++, 18446744073709551616/2, 9223372036854775808;
270 tryeq_sloppy $T++, 18446744073709551616/4294967296, 4294967296;
271 tryeq_sloppy $T++, 18446744073709551616/9223372036854775808, 2;
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;
280   tryeq_sloppy $T++, $float, 21307064320;
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;
285   tryeq $T++, $int, 21307064320;
286
287   my $t = time;
288   my $t1000 = time() * 1000;
289   try $T++, abs($t1000 -1000 * $t) <= 2000;
290 }
291
292 my $vms_no_ieee;
293 if ($^O eq 'VMS') {
294   use vars '%Config';
295   eval {require Config; import Config};
296   $vms_no_ieee = 1 unless defined($Config{useieee});
297 }
298
299 if ($^O eq 'vos') {
300   print "not ok ", $T++, " # TODO VOS raises SIGFPE instead of producing infinity.\n";
301 }
302 elsif ($vms_no_ieee) {
303  print $T++, " # SKIP -- the IEEE infinity model is unavailable in this configuration.\n"
304 }
305 elsif ($^O eq 'ultrix') {
306   print "not ok ", $T++, " # TODO Ultrix enters deep nirvana instead of producing infinity.\n";
307 }
308 else {
309   # The computation of $v should overflow and produce "infinity"
310   # on any system whose max exponent is less than 10**1506.
311   # The exact string used to represent infinity varies by OS,
312   # so we don't test for it; all we care is that we don't die.
313   #
314   # Perl considers it to be an error if SIGFPE is raised.
315   # Chances are the interpreter will die, since it doesn't set
316   # up a handler for SIGFPE.  That's why this test is last; to
317   # minimize the number of test failures.  --PG
318
319   my $n = 5000;
320   my $v = 2;
321   while (--$n)
322   {
323     $v *= 2;
324   }
325   print "ok ", $T++, "\n";
326 }