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