1(* Test the types nativeint, int32, int64 *)
2
3open Printf
4
5let error_occurred = ref false
6
7let function_tested = ref ""
8
9let testing_function s =
10    function_tested := s;
11    print_newline();
12    print_string s;
13    print_newline()
14
15let test test_number answer correct_answer =
16 flush stdout;
17 flush stderr;
18 if answer <> correct_answer then begin
19   eprintf "*** Bad result (%s, test %d)\n" !function_tested test_number;
20   flush stderr;
21   error_occurred := true
22 end else begin
23   printf " %d..." test_number
24 end
25
26(***** Tests on 32 bit arithmetic *****)
27
28module type TESTSIG = sig
29  type t
30  module Ops : sig
31    val neg: t -> t
32    val add: t -> t -> t
33    val sub: t -> t -> t
34    val mul: t -> t -> t
35    val div: t -> t -> t
36    val rem: t -> t -> t
37    val logand: t -> t -> t
38    val logor: t -> t -> t
39    val logxor: t -> t -> t
40    val shift_left: t -> int -> t
41    val shift_right: t -> int -> t
42    val shift_right_logical: t -> int -> t
43    val of_int: int -> t
44    val to_int: t -> int
45    val of_float: float -> t
46    val to_float: t -> float
47    val zero: t
48    val one: t
49    val minus_one: t
50    val min_int: t
51    val max_int: t
52    val format : string -> t -> string
53    val to_string: t -> string
54    val of_string: string -> t
55  end
56  val testcomp: t -> t -> bool*bool*bool*bool*bool*bool*int
57  val skip_float_tests: bool
58end
59
60module Test32(M: TESTSIG) =
61struct
62  open M
63  open Ops
64
65  let _ =
66    testing_function "of_int, to_int";
67    test 1 (to_int (of_int 0)) 0;
68    test 2 (to_int (of_int 123)) 123;
69    test 3 (to_int (of_int (-456))) (-456);
70    test 4 (to_int (of_int 0x3FFFFFFF)) 0x3FFFFFFF;
71    test 5 (to_int (of_int (-0x40000000))) (-0x40000000);
72
73    testing_function "of_string";
74    test 1 (of_string "0") (of_int 0);
75    test 2 (of_string "123") (of_int 123);
76    test 3 (of_string "-456") (of_int (-456));
77    test 4 (of_string "123456789") (of_int 123456789);
78    test 5 (of_string "0xABCDEF") (of_int 0xABCDEF);
79    test 6 (of_string "-0o1234567012") (of_int (- 0o1234567012));
80    test 7 (of_string "0b01010111111000001100")
81           (of_int 0b01010111111000001100);
82    test 8 (of_string "0x7FFFFFFF") max_int;
83    test 9 (of_string "-0x80000000") min_int;
84    test 10 (of_string "0x80000000") min_int;
85    test 11 (of_string "0xFFFFFFFF") minus_one;
86
87    testing_function "to_string, format";
88    List.iter (fun (n, s) -> test n (to_string (of_string s)) s)
89      [1, "0"; 2, "123"; 3, "-456"; 4, "1234567890";
90       5, "1073741824"; 6, "2147483647"; 7, "-2147483648"];
91    List.iter (fun (n, s) -> test n (format "0x%X" (of_string s)) s)
92      [8, "0x0"; 9, "0x123"; 10, "0xABCDEF"; 11, "0x12345678";
93       12, "0x7FFFFFFF"; 13, "0x80000000"; 14, "0xFFFFFFFF"];
94    test 15 (to_string max_int) "2147483647";
95    test 16 (to_string min_int) "-2147483648";
96    test 17 (to_string zero) "0";
97    test 18 (to_string one) "1";
98    test 19 (to_string minus_one) "-1";
99
100    testing_function "neg";
101    test 1 (neg (of_int 0)) (of_int 0);
102    test 2 (neg (of_int 123)) (of_int (-123));
103    test 3 (neg (of_int (-456))) (of_int 456);
104    test 4 (neg (of_int 123456789)) (of_int (-123456789));
105    test 5 (neg max_int) (of_string "-0x7FFFFFFF");
106    test 6 (neg min_int) min_int;
107
108    testing_function "add";
109    test 1 (add (of_int 0) (of_int 0)) (of_int 0);
110    test 2 (add (of_int 123) (of_int 0)) (of_int 123);
111    test 3 (add (of_int 0) (of_int 456)) (of_int 456);
112    test 4 (add (of_int 123) (of_int 456)) (of_int 579);
113    test 5 (add (of_int (-123)) (of_int 456)) (of_int 333);
114    test 6 (add (of_int 123) (of_int (-456))) (of_int (-333));
115    test 7 (add (of_int (-123)) (of_int (-456))) (of_int (-579));
116    test 8 (add (of_string "0x12345678") (of_string "0x9ABCDEF"))
117           (of_string "0x1be02467");
118    test 9 (add max_int max_int) (of_int (-2));
119    test 10 (add min_int min_int) zero;
120    test 11 (add max_int one) min_int;
121    test 12 (add min_int minus_one) max_int;
122    test 13 (add max_int min_int) minus_one;
123
124    testing_function "sub";
125    test 1 (sub (of_int 0) (of_int 0)) (of_int 0);
126    test 2 (sub (of_int 123) (of_int 0)) (of_int 123);
127    test 3 (sub (of_int 0) (of_int 456)) (of_int (-456));
128    test 4 (sub (of_int 123) (of_int 456)) (of_int (-333));
129    test 5 (sub (of_int (-123)) (of_int 456)) (of_int (-579));
130    test 6 (sub (of_int 123) (of_int (-456))) (of_int 579);
131    test 7 (sub (of_int (-123)) (of_int (-456))) (of_int 333);
132    test 8 (sub (of_string "0x12345678") (of_string "0x9ABCDEF"))
133           (of_string "0x8888889");
134    test 9 (sub max_int min_int) minus_one;
135    test 10 (sub min_int max_int) one;
136    test 11 (sub min_int one) max_int;
137    test 12 (sub max_int minus_one) min_int;
138
139    testing_function "mul";
140    test 1 (mul (of_int 0) (of_int 0)) (of_int 0);
141    test 2 (mul (of_int 123) (of_int 0)) (of_int 0);
142    test 3 (mul (of_int 0) (of_int (-456))) (of_int 0);
143    test 4 (mul (of_int 123) (of_int 1)) (of_int 123);
144    test 5 (mul (of_int 1) (of_int (-456))) (of_int (-456));
145    test 6 (mul (of_int 123) (of_int (-1))) (of_int (-123));
146    test 7 (mul (of_int (-1)) (of_int (-456))) (of_int 456);
147    test 8 (mul (of_int 123) (of_int 456)) (of_int 56088);
148    test 9 (mul (of_int (-123)) (of_int 456)) (of_int (-56088));
149    test 10 (mul (of_int 123) (of_int (-456))) (of_int (-56088));
150    test 11 (mul (of_int (-123)) (of_int (-456))) (of_int 56088);
151    test 12 (mul (of_string "0x12345678") (of_string "0x9ABCDEF"))
152            (of_string "0xe242d208");
153    test 13 (mul max_int max_int) one;
154
155    testing_function "div";
156    List.iter
157      (fun (n, a, b) -> test n (div (of_int a) (of_int b)) (of_int (a / b)))
158      [1, 0, 2;
159       2, 123, 1;
160       3, -123, 1;
161       4, 123, -1;
162       5, -123, -1;
163       6, 127531236, 365;
164       7, 16384, 256;
165       8, -127531236, 365;
166       9, 127531236, -365;
167       10, 1234567, 12345678;
168       11, 1234567, -12345678];
169    test 12 (div min_int (of_int (-1))) min_int;
170
171    testing_function "mod";
172    List.iter
173      (fun (n, a, b) -> test n (rem (of_int a) (of_int b)) (of_int (a mod b)))
174      [1, 0, 2;
175       2, 123, 1;
176       3, -123, 1;
177       4, 123, -1;
178       5, -123, -1;
179       6, 127531236, 365;
180       7, 16384, 256;
181       8, -127531236, 365;
182       9, 127531236, -365;
183       10, 1234567, 12345678;
184       11, 1234567, -12345678];
185    test 12 (rem min_int (of_int (-1))) (of_int 0);
186
187    testing_function "and";
188    List.iter
189      (fun (n, a, b, c) -> test n (logand (of_string a) (of_string b))
190                                  (of_string c))
191      [1, "0x12345678", "0x9abcdef0", "0x12345670";
192       2, "0x12345678", "0x0fedcba9", "0x2244228";
193       3, "0xFFFFFFFF", "0x12345678", "0x12345678";
194       4, "0", "0x12345678", "0";
195       5, "0x55555555", "0xAAAAAAAA", "0"];
196
197    testing_function "or";
198    List.iter
199      (fun (n, a, b, c) -> test n (logor (of_string a) (of_string b))
200                                  (of_string c))
201      [1, "0x12345678", "0x9abcdef0", "0x9abcdef8";
202       2, "0x12345678", "0x0fedcba9", "0x1ffddff9";
203       3, "0xFFFFFFFF", "0x12345678", "0xFFFFFFFF";
204       4, "0", "0x12345678", "0x12345678";
205       5, "0x55555555", "0xAAAAAAAA", "0xFFFFFFFF"];
206
207    testing_function "xor";
208    List.iter
209      (fun (n, a, b, c) -> test n (logxor (of_string a) (of_string b))
210                                  (of_string c))
211      [1, "0x12345678", "0x9abcdef0", "0x88888888";
212       2, "0x12345678", "0x0fedcba9", "0x1dd99dd1";
213       3, "0xFFFFFFFF", "0x12345678", "0xedcba987";
214       4, "0", "0x12345678", "0x12345678";
215       5, "0x55555555", "0xAAAAAAAA", "0xFFFFFFFF"];
216
217    testing_function "shift_left";
218    List.iter
219      (fun (n, a, b, c) -> test n (shift_left (of_string a) b) (of_string c))
220      [1, "1", 1, "2";
221       2, "1", 2, "4";
222       3, "1", 4, "0x10";
223       4, "1", 30, "0x40000000";
224       5, "1", 31, "0x80000000";
225       6, "0x16236", 7, "0xb11b00";
226       7, "0x10", 27, "0x80000000";
227       8, "0x10", 28, "0"];
228
229    testing_function "shift_right";
230    List.iter
231      (fun (n, a, b, c) -> test n (shift_right (of_string a) b) (of_string c))
232      [1, "2", 1, "1";
233       2, "4", 2, "1";
234       3, "0x10", 4, "1";
235       4, "0x40000000", 10, "0x100000";
236       5, "0x80000000", 31, "-1";
237       6, "0xb11b00", 7, "0x16236";
238       7, "-0xb11b00", 7, "-90678"];
239
240    testing_function "shift_right_logical";
241    List.iter
242      (fun (n, a, b, c) -> test n (shift_right_logical (of_string a) b)
243                                  (of_string c))
244      [1, "2", 1, "1";
245       2, "4", 2, "1";
246       3, "0x10", 4, "1";
247       4, "0x40000000", 10, "0x100000";
248       5, "0x80000000", 31, "1";
249       6, "0xb11b00", 7, "0x16236";
250       7, "-0xb11b00", 7, "0x1fe9dca"];
251
252    if not (skip_float_tests) then begin
253      testing_function "of_float";
254      test 1 (of_float 0.0) (of_int 0);
255      test 2 (of_float 123.0) (of_int 123);
256      test 3 (of_float 123.456) (of_int 123);
257      test 4 (of_float 123.999) (of_int 123);
258      test 5 (of_float (-456.0)) (of_int (-456));
259      test 6 (of_float (-456.123)) (of_int (-456));
260      test 7 (of_float (-456.789)) (of_int (-456));
261
262      testing_function "to_float";
263      test 1 (to_float (of_int 0)) 0.0;
264      test 2 (to_float (of_int 123)) 123.0;
265      test 3 (to_float (of_int (-456))) (-456.0);
266      test 4 (to_float (of_int 0x3FFFFFFF)) 1073741823.0;
267      test 5 (to_float (of_int (-0x40000000))) (-1073741824.0)
268    end;
269
270    testing_function "Comparisons";
271    test 1 (testcomp (of_int 0) (of_int 0))
272           (true,false,false,false,true,true,0);
273    test 2 (testcomp (of_int 1234567) (of_int 1234567))
274           (true,false,false,false,true,true,0);
275    test 3 (testcomp (of_int 0) (of_int 1))
276           (false,true,true,false,true,false,-1);
277    test 4 (testcomp (of_int (-1)) (of_int 0))
278           (false,true,true,false,true,false,-1);
279    test 5 (testcomp (of_int 1) (of_int 0))
280           (false,true,false,true,false,true,1);
281    test 6 (testcomp (of_int 0) (of_int (-1)))
282           (false,true,false,true,false,true,1);
283    test 7 (testcomp max_int min_int)
284           (false,true,false,true,false,true,1);
285
286    ()
287end
288
289(********* Tests on 64-bit arithmetic ***********)
290
291module Test64(M: TESTSIG) =
292struct
293  open M
294  open Ops
295
296  let _ =
297    testing_function "of_int, to_int";
298    test 1 (to_int (of_int 0)) 0;
299    test 2 (to_int (of_int 123)) 123;
300    test 3 (to_int (of_int (-456))) (-456);
301    test 4 (to_int (of_int 0x3FFFFFFF)) 0x3FFFFFFF;
302    test 5 (to_int (of_int (-0x40000000))) (-0x40000000);
303
304    testing_function "of_string";
305    test 1 (of_string "0") (of_int 0);
306    test 2 (of_string "123") (of_int 123);
307    test 3 (of_string "-456") (of_int (-456));
308    test 4 (of_string "123456789") (of_int 123456789);
309    test 5 (of_string "0xABCDEF") (of_int 0xABCDEF);
310    test 6 (of_string "-0o1234567012") (of_int (- 0o1234567012));
311    test 7 (of_string "0b01010111111000001100")
312           (of_int 0b01010111111000001100);
313    test 8 (of_string "0x7FFFFFFFFFFFFFFF") max_int;
314    test 9 (of_string "-0x8000000000000000") min_int;
315    test 10 (of_string "0x8000000000000000") min_int;
316    test 11 (of_string "0xFFFFFFFFFFFFFFFF") minus_one;
317
318    testing_function "to_string, format";
319    List.iter (fun (n, s) -> test n (to_string (of_string s)) s)
320      [1, "0"; 2, "123"; 3, "-456"; 4, "1234567890";
321       5, "1234567890123456789";
322       6, "9223372036854775807";
323       7, "-9223372036854775808"];
324    List.iter (fun (n, s) -> test n ("0x" ^ format "%X" (of_string s)) s)
325      [8, "0x0"; 9, "0x123"; 10, "0xABCDEF"; 11, "0x1234567812345678";
326       12, "0x7FFFFFFFFFFFFFFF"; 13, "0x8000000000000000";
327       14, "0xFFFFFFFFFFFFFFFF"];
328    test 15 (to_string max_int) "9223372036854775807";
329    test 16 (to_string min_int) "-9223372036854775808";
330    test 17 (to_string zero) "0";
331    test 18 (to_string one) "1";
332    test 19 (to_string minus_one) "-1";
333
334    testing_function "neg";
335    test 1 (neg (of_int 0)) (of_int 0);
336    test 2 (neg (of_int 123)) (of_int (-123));
337    test 3 (neg (of_int (-456))) (of_int 456);
338    test 4 (neg (of_int 123456789)) (of_int (-123456789));
339    test 5 (neg max_int) (of_string "-0x7FFFFFFFFFFFFFFF");
340    test 6 (neg min_int) min_int;
341
342    testing_function "add";
343    test 1 (add (of_int 0) (of_int 0)) (of_int 0);
344    test 2 (add (of_int 123) (of_int 0)) (of_int 123);
345    test 3 (add (of_int 0) (of_int 456)) (of_int 456);
346    test 4 (add (of_int 123) (of_int 456)) (of_int 579);
347    test 5 (add (of_int (-123)) (of_int 456)) (of_int 333);
348    test 6 (add (of_int 123) (of_int (-456))) (of_int (-333));
349    test 7 (add (of_int (-123)) (of_int (-456))) (of_int (-579));
350    test 8 (add (of_string "0x1234567812345678")
351                (of_string "0x9ABCDEF09ABCDEF"))
352           (of_string "0x1be024671be02467");
353    test 9 (add max_int max_int) (of_int (-2));
354    test 10 (add min_int min_int) zero;
355    test 11 (add max_int one) min_int;
356    test 12 (add min_int minus_one) max_int;
357    test 13 (add max_int min_int) minus_one;
358
359    testing_function "sub";
360    test 1 (sub (of_int 0) (of_int 0)) (of_int 0);
361    test 2 (sub (of_int 123) (of_int 0)) (of_int 123);
362    test 3 (sub (of_int 0) (of_int 456)) (of_int (-456));
363    test 4 (sub (of_int 123) (of_int 456)) (of_int (-333));
364    test 5 (sub (of_int (-123)) (of_int 456)) (of_int (-579));
365    test 6 (sub (of_int 123) (of_int (-456))) (of_int 579);
366    test 7 (sub (of_int (-123)) (of_int (-456))) (of_int 333);
367    test 8 (sub (of_string "0x1234567812345678")
368                (of_string "0x9ABCDEF09ABCDEF"))
369           (of_string "0x888888908888889");
370    test 9 (sub max_int min_int) minus_one;
371    test 10 (sub min_int max_int) one;
372    test 11 (sub min_int one) max_int;
373    test 12 (sub max_int minus_one) min_int;
374
375    testing_function "mul";
376    test 1 (mul (of_int 0) (of_int 0)) (of_int 0);
377    test 2 (mul (of_int 123) (of_int 0)) (of_int 0);
378    test 3 (mul (of_int 0) (of_int (-456))) (of_int 0);
379    test 4 (mul (of_int 123) (of_int 1)) (of_int 123);
380    test 5 (mul (of_int 1) (of_int (-456))) (of_int (-456));
381    test 6 (mul (of_int 123) (of_int (-1))) (of_int (-123));
382    test 7 (mul (of_int (-1)) (of_int (-456))) (of_int 456);
383    test 8 (mul (of_int 123) (of_int 456)) (of_int 56088);
384    test 9 (mul (of_int (-123)) (of_int 456)) (of_int (-56088));
385    test 10 (mul (of_int 123) (of_int (-456))) (of_int (-56088));
386    test 11 (mul (of_int (-123)) (of_int (-456))) (of_int 56088);
387    test 12 (mul (of_string "0x12345678") (of_string "0x9ABCDEF"))
388           (of_string "0xb00ea4e242d208");
389    test 13 (mul max_int max_int) one;
390
391    testing_function "div";
392    List.iter
393      (fun (n, a, b) -> test n (div (of_int a) (of_int b)) (of_int (a / b)))
394      [1, 0, 2;
395       2, 123, 1;
396       3, -123, 1;
397       4, 123, -1;
398       5, -123, -1;
399       6, 127531236, 365;
400       7, 16384, 256;
401       8, -127531236, 365;
402       9, 127531236, -365;
403       10, 1234567, 12345678;
404       11, 1234567, -12345678];
405    test 12 (div min_int (of_int (-1))) min_int;
406
407    testing_function "mod";
408    List.iter
409      (fun (n, a, b) -> test n (rem (of_int a) (of_int b)) (of_int (a mod b)))
410      [1, 0, 2;
411       2, 123, 1;
412       3, -123, 1;
413       4, 123, -1;
414       5, -123, -1;
415       6, 127531236, 365;
416       7, 16384, 256;
417       8, -127531236, 365;
418       9, 127531236, -365;
419       10, 1234567, 12345678;
420       11, 1234567, -12345678];
421    test 12 (rem min_int (of_int (-1))) (of_int 0);
422
423    testing_function "and";
424    List.iter
425      (fun (n, a, b, c) -> test n (logand (of_string a) (of_string b))
426                                  (of_string c))
427      [1, "0x1234567812345678", "0x9abcdef09abcdef0", "0x1234567012345670";
428       2, "0x1234567812345678", "0x0fedcba90fedcba9", "0x224422802244228";
429       3, "0xFFFFFFFFFFFFFFFF", "0x1234000012345678", "0x1234000012345678";
430       4, "0", "0x1234567812345678", "0";
431       5, "0x5555555555555555", "0xAAAAAAAAAAAAAAAA", "0"];
432
433    testing_function "or";
434    List.iter
435      (fun (n, a, b, c) -> test n (logor (of_string a) (of_string b))
436                                  (of_string c))
437      [1, "0x1234567812345678", "0x9abcdef09abcdef0", "0x9abcdef89abcdef8";
438       2, "0x1234567812345678", "0x0fedcba90fedcba9", "0x1ffddff91ffddff9";
439       3, "0xFFFFFFFFFFFFFFFF", "0x12345678", "0xFFFFFFFFFFFFFFFF";
440       4, "0", "0x1234567812340000", "0x1234567812340000";
441       5, "0x5555555555555555", "0xAAAAAAAAAAAAAAAA", "0xFFFFFFFFFFFFFFFF"];
442
443    testing_function "xor";
444    List.iter
445      (fun (n, a, b, c) -> test n (logxor (of_string a) (of_string b))
446                                  (of_string c))
447      [1, "0x1234567812345678", "0x9abcdef09abcdef0", "0x8888888888888888";
448       2, "0x1234567812345678", "0x0fedcba90fedcba9", "0x1dd99dd11dd99dd1";
449       3, "0xFFFFFFFFFFFFFFFF", "0x123456789ABCDEF", "0xfedcba9876543210";
450       4, "0", "0x1234567812340000", "0x1234567812340000";
451       5, "0x5555555555555555", "0xAAAAAAAAAAAAAAAA", "0xFFFFFFFFFFFFFFFF"];
452
453    testing_function "shift_left";
454    List.iter
455      (fun (n, a, b, c) -> test n (shift_left (of_string a) b) (of_string c))
456      [1, "1", 1, "2";
457       2, "1", 2, "4";
458       3, "1", 4, "0x10";
459       4, "1", 62, "0x4000000000000000";
460       5, "1", 63, "0x8000000000000000";
461       6, "0x16236ABD45673", 7, "0xb11b55ea2b3980";
462       7, "0x10", 59, "0x8000000000000000";
463       8, "0x10", 60, "0"];
464
465    testing_function "shift_right";
466    List.iter
467      (fun (n, a, b, c) -> test n (shift_right (of_string a) b) (of_string c))
468      [1, "2", 1, "1";
469       2, "4", 2, "1";
470       3, "0x10", 4, "1";
471       4, "0x40000000", 10, "0x100000";
472       5, "0x8000000000000000", 63, "-1";
473       6, "0xb11b55ea2b3980", 7, "0x16236ABD45673";
474       7, "-0xb11b55ea2b3980", 7, "-389461927286387"];
475
476    testing_function "shift_right_logical";
477    List.iter
478      (fun (n, a, b, c) -> test n (shift_right_logical (of_string a) b)
479                                  (of_string c))
480      [1, "2", 1, "1";
481       2, "4", 2, "1";
482       3, "0x10", 4, "1";
483       4, "0x40000000", 10, "0x100000";
484       5, "0x8000000000000000", 63, "1";
485       6, "0xb11b55ea2b3980", 7, "0x16236ABD45673";
486       7, "-0xb11b55ea2b3980", 7, "0x1fe9dc9542ba98d"];
487
488    testing_function "Comparisons";
489    test 1 (testcomp (of_int 0) (of_int 0))
490           (true,false,false,false,true,true,0);
491    test 2 (testcomp (of_int 1234567) (of_int 1234567))
492           (true,false,false,false,true,true,0);
493    test 3 (testcomp (of_int 0) (of_int 1))
494           (false,true,true,false,true,false,-1);
495    test 4 (testcomp (of_int (-1)) (of_int 0))
496           (false,true,true,false,true,false,-1);
497    test 5 (testcomp (of_int 1) (of_int 0))
498           (false,true,false,true,false,true,1);
499    test 6 (testcomp (of_int 0) (of_int (-1)))
500           (false,true,false,true,false,true,1);
501    test 7 (testcomp max_int min_int)
502           (false,true,false,true,false,true,1);
503
504    ()
505end
506
507(******** The test proper **********)
508
509let testcomp_int32 (a : int32) (b : int32) =
510  (a = b, a <> b, a < b, a > b, a <= b, a >= b, compare a b)
511let testcomp_int64 (a : int64) (b : int64) =
512  (a = b, a <> b, a < b, a > b, a <= b, a >= b, compare a b)
513let testcomp_nativeint (a : nativeint) (b : nativeint) =
514  (a = b, a <> b, a < b, a > b, a <= b, a >= b, compare a b)
515
516let _ =
517  testing_function "-------- Int32 --------";
518  let module A = Test32(struct type t = int32
519                               module Ops = Int32
520                               let testcomp = testcomp_int32
521                               let skip_float_tests = false end) in
522  print_newline(); testing_function "-------- Int64 --------";
523  let module B = Test64(struct type t = int64
524                               module Ops = Int64
525                               let testcomp = testcomp_int64
526                               let skip_float_tests = false end) in
527  print_newline(); testing_function "-------- Nativeint --------";
528  begin match Sys.word_size with
529    32 ->
530      let module C =
531        Test32(struct type t = nativeint
532                      module Ops = Nativeint
533                      let testcomp = testcomp_nativeint
534                      let skip_float_tests = true end)
535      in ()
536  | 64 ->
537      let module C =
538        Test64(struct type t = nativeint
539                      module Ops = Nativeint
540                      let testcomp = testcomp_nativeint
541                      let skip_float_tests = true end)
542      in ()
543  | _ ->
544      assert false
545  end;
546  print_newline(); testing_function "--------- Conversions -----------";
547  testing_function "nativeint of/to int32";
548  test 1 (Nativeint.of_int32 (Int32.of_string "0x12345678"))
549         (Nativeint.of_string "0x12345678");
550  test 2 (Nativeint.to_int32 (Nativeint.of_string "0x12345678"))
551         (Int32.of_string "0x12345678");
552  if Sys.word_size = 64 then
553  test 3 (Nativeint.to_int32 (Nativeint.of_string "0x123456789ABCDEF0"))
554         (Int32.of_string "0x9ABCDEF0")
555  else
556  test 3 0 0; (* placeholder to have the same output on 32-bit and 64-bit *)
557  testing_function "int64 of/to int32";
558  test 1 (Int64.of_int32 (Int32.of_string "-0x12345678"))
559         (Int64.of_string "-0x12345678");
560  test 2 (Int64.to_int32 (Int64.of_string "-0x12345678"))
561         (Int32.of_string "-0x12345678");
562  test 3 (Int64.to_int32 (Int64.of_string "0x123456789ABCDEF0"))
563         (Int32.of_string "0x9ABCDEF0");
564  testing_function "int64 of/to nativeint";
565  test 1 (Int64.of_nativeint (Nativeint.of_string "0x12345678"))
566         (Int64.of_string "0x12345678");
567  test 2 (Int64.to_nativeint (Int64.of_string "-0x12345678"))
568         (Nativeint.of_string "-0x12345678");
569  test 3 (Int64.to_nativeint (Int64.of_string "0x123456789ABCDEF0"))
570         (if Sys.word_size = 64
571          then Nativeint.of_string "0x123456789ABCDEF0"
572          else Nativeint.of_string "0x9ABCDEF0")
573
574(********* End of test *********)
575
576let _ =
577  print_newline();
578  if !error_occurred then begin
579    prerr_endline "************* TEST FAILED ****************"; exit 2
580  end else
581    exit 0
582