← Back to branch summary

~ubuntu-branches/debian/sid/ocaml/sid

« back to all changes in this revision

Viewing changes to testsuite/tests/lib-bigarray/bigarrays.ml

  • Committer: Bazaar Package Importer
  • Author(s): Stéphane Glondu
  • Date: 2011-04-21 21:35:08 UTC
  • mfrom: (1.1.11 upstream) (12.1.14 sid)
  • Revision ID: james.westby@ubuntu.com-20110421213508-kg34453aqmb0moha
* Fixes related to -output-obj with g++ (in debian/patches):
  - add Declare-primitive-name-table-as-const-char
  - add Avoid-multiple-declarations-in-generated-.c-files-in
  - fix Embed-bytecode-in-C-object-when-using-custom: the closing
    brace for extern "C" { ... } was missing in some cases

Show diffs side-by-side

added added

removed removed

Lines of Context:
testsuite/tests/lib-bigarray/bigarrays.ml
 
1
open Bigarray
 
2
open Printf
 
3
open Complex
 
4
 
 
5
(* Test harness *)
 
6
 
 
7
let error_occurred = ref false
 
8
 
 
9
let function_tested = ref ""
 
10
 
 
11
let testing_function s =
 
12
    function_tested := s;
 
13
    print_newline();
 
14
    print_string s;
 
15
    print_newline()
 
16
 
 
17
let test test_number answer correct_answer =
 
18
 flush stdout;
 
19
 flush stderr;
 
20
 if answer <> correct_answer then begin
 
21
   eprintf "*** Bad result (%s, test %d)\n" !function_tested test_number;
 
22
   flush stderr;
 
23
   error_occurred := true
 
24
 end else begin
 
25
   printf " %d..." test_number
 
26
 end
 
27
 
 
28
(* One-dimensional arrays *)
 
29
 
 
30
let _ =
 
31
  testing_function "------ Array1 --------";
 
32
  testing_function "create/set/get";
 
33
  let test_setget kind vals =
 
34
    let rec set a i = function
 
35
        [] -> ()
 
36
      | (v1, v2) :: tl -> a.{i} <- v1; set a (i+1) tl in
 
37
    let rec test a i = function
 
38
        [] -> true
 
39
      | (v1, v2) :: tl -> a.{i} = v2 && test a (i+1) tl in
 
40
    let ca = Array1.create kind c_layout (List.length vals) in
 
41
    let fa = Array1.create kind fortran_layout (List.length vals) in
 
42
    set ca 0 vals;
 
43
    set fa 1 vals;
 
44
    test ca 0 vals && test fa 1 vals in
 
45
  test 1 true
 
46
    (test_setget int8_signed
 
47
                 [0, 0;
 
48
                  123, 123;
 
49
                  -123, -123;
 
50
                  456, -56;
 
51
                  0x101, 1]);
 
52
  test 2 true
 
53
    (test_setget int8_unsigned
 
54
                 [0, 0;
 
55
                  123, 123;
 
56
                  -123, 133;
 
57
                  456, 0xc8;
 
58
                  0x101, 1]);
 
59
  test 3 true
 
60
    (test_setget int16_signed
 
61
                 [0, 0;
 
62
                  123, 123;
 
63
                  -123, -123;
 
64
                  31456, 31456;
 
65
                  -31456, -31456;
 
66
                  65432, -104;
 
67
                  0x10001, 1]);
 
68
  test 4 true
 
69
    (test_setget int16_unsigned
 
70
                 [0, 0;
 
71
                  123, 123;
 
72
                  -123, 65413;
 
73
                  31456, 31456;
 
74
                  -31456, 34080;
 
75
                  65432, 65432;
 
76
                  0x10001, 1]);
 
77
  test 5 true
 
78
    (test_setget int
 
79
                 [0, 0;
 
80
                  123, 123;
 
81
                  -456, -456;
 
82
                  max_int, max_int;
 
83
                  min_int, min_int;
 
84
                  0x12345678, 0x12345678;
 
85
                  -0x12345678, -0x12345678]);
 
86
  test 6 true
 
87
    (test_setget int32
 
88
                 [Int32.zero, Int32.zero;
 
89
                  Int32.of_int 123, Int32.of_int 123;
 
90
                  Int32.of_int (-456), Int32.of_int (-456);
 
91
                  Int32.max_int, Int32.max_int;
 
92
                  Int32.min_int, Int32.min_int;
 
93
                  Int32.of_string "0x12345678", Int32.of_string "0x12345678"]);
 
94
  test 7 true
 
95
    (test_setget int64
 
96
                 [Int64.zero, Int64.zero;
 
97
                  Int64.of_int 123, Int64.of_int 123;
 
98
                  Int64.of_int (-456), Int64.of_int (-456);
 
99
                  Int64.max_int, Int64.max_int;
 
100
                  Int64.min_int, Int64.min_int;
 
101
                  Int64.of_string "0x123456789ABCDEF0",
 
102
                     Int64.of_string "0x123456789ABCDEF0"]);
 
103
  test 8 true
 
104
    (test_setget nativeint
 
105
                 [Nativeint.zero, Nativeint.zero;
 
106
                  Nativeint.of_int 123, Nativeint.of_int 123;
 
107
                  Nativeint.of_int (-456), Nativeint.of_int (-456);
 
108
                  Nativeint.max_int, Nativeint.max_int;
 
109
                  Nativeint.min_int, Nativeint.min_int;
 
110
                  Nativeint.of_string "0x12345678",
 
111
                    Nativeint.of_string "0x12345678"]);
 
112
  test 9 true
 
113
    (test_setget float32
 
114
                 [0.0, 0.0;
 
115
                  4.0, 4.0;
 
116
                  -0.5, -0.5;
 
117
                  655360.0, 655360.0]);
 
118
  test 10 true
 
119
    (test_setget float64
 
120
                 [0.0, 0.0;
 
121
                  4.0, 4.0;
 
122
                  -0.5, -0.5;
 
123
                  1.2345678, 1.2345678;
 
124
                  3.1415e10, 3.1415e10]);
 
125
  test 11 true
 
126
    (test_setget complex32
 
127
                 [Complex.zero, Complex.zero;
 
128
                  Complex.one, Complex.one;
 
129
                  Complex.i, Complex.i;
 
130
                  {im = 0.5; re = -2.0}, {im = 0.5; re = -2.0}]);
 
131
  test 12 true
 
132
    (test_setget complex64
 
133
                 [Complex.zero, Complex.zero;
 
134
                  Complex.one, Complex.one;
 
135
                  Complex.i, Complex.i;
 
136
                  {im=0.5;re= -2.0}, {im=0.5;re= -2.0};
 
137
                  {im=3.1415;re=1.2345678}, {im=3.1415;re=1.2345678}]);
 
138
 
 
139
  let from_list kind vals =
 
140
    let a = Array1.create kind c_layout (List.length vals) in
 
141
    let rec set i = function
 
142
        [] -> () 
 
143
      | hd :: tl -> a.{i} <- hd; set (i+1) tl in
 
144
    set 0 vals;
 
145
    a in
 
146
  let from_list_fortran kind vals =
 
147
    let a = Array1.create kind fortran_layout (List.length vals) in
 
148
    let rec set i = function
 
149
        [] -> () 
 
150
      | hd :: tl -> a.{i} <- hd; set (i+1) tl in
 
151
    set 1 vals;
 
152
    a in
 
153
 
 
154
  testing_function "set/get (specialized)";
 
155
  let a = Array1.create int c_layout 3 in
 
156
  for i = 0 to 2 do a.{i} <- i done;
 
157
  for i = 0 to 2 do test (i+1) a.{i} i done;
 
158
  test 4 true (try ignore a.{3}; false with Invalid_argument _ -> true);
 
159
  test 5 true (try ignore a.{-1}; false with Invalid_argument _ -> true);
 
160
    
 
161
  let b = Array1.create float64 fortran_layout 3 in
 
162
  for i = 1 to 3 do b.{i} <- float i done;
 
163
  for i = 1 to 3 do test (5 + i) b.{i} (float i) done;
 
164
  test 8 true (try ignore b.{4}; false with Invalid_argument _ -> true);
 
165
  test 9 true (try ignore b.{0}; false with Invalid_argument _ -> true);
 
166
 
 
167
  let c = Array1.create complex64 c_layout 3 in
 
168
  for i = 0 to 2 do c.{i} <- {re=float i; im=0.0} done;
 
169
  for i = 0 to 2 do test (10 + i) c.{i} {re=float i; im=0.0} done;
 
170
  test 13 true (try ignore c.{3}; false with Invalid_argument _ -> true);
 
171
  test 14 true (try ignore c.{-1}; false with Invalid_argument _ -> true);
 
172
 
 
173
  let d = Array1.create complex32 fortran_layout 3 in
 
174
  for i = 1 to 3 do d.{i} <- {re=float i; im=0.0} done;
 
175
  for i = 1 to 3 do test (14 + i) d.{i} {re=float i; im=0.0} done;
 
176
  test 18 true (try ignore d.{4}; false with Invalid_argument _ -> true);
 
177
  test 19 true (try ignore d.{0}; false with Invalid_argument _ -> true);
 
178
 
 
179
  testing_function "set/get (unsafe, specialized)";
 
180
  let a = Array1.create int c_layout 3 in
 
181
  for i = 0 to 2 do Array1.unsafe_set a i i done;
 
182
  for i = 0 to 2 do test (i+1) (Array1.unsafe_get a i) i done;
 
183
    
 
184
  let b = Array1.create float64 fortran_layout 3 in
 
185
  for i = 1 to 3 do Array1.unsafe_set b i (float i) done;
 
186
  for i = 1 to 3 do test (5 + i) (Array1.unsafe_get b i) (float i) done;
 
187
 
 
188
  testing_function "comparisons";
 
189
  let normalize_comparison n =
 
190
    if n = 0 then 0 else if n < 0 then -1 else 1 in
 
191
  test 1 0 (normalize_comparison (compare
 
192
     (from_list int8_signed [1;2;3;-4;127;-128])
 
193
     (from_list int8_signed [1;2;3;-4;127;-128])));
 
194
  test 2 (-1) (normalize_comparison (compare
 
195
     (from_list int8_signed [1;2;3;-4;127;-128])
 
196
     (from_list int8_signed [1;2;3;4;127;-128])));
 
197
  test 3 1 (normalize_comparison (compare
 
198
     (from_list int8_signed [1;2;3;-4;127;-128])
 
199
     (from_list int8_signed [1;2;3;-4;42;-128])));
 
200
  test 4 (-1) (normalize_comparison (compare
 
201
     (from_list int8_signed [1;2;3;-4])
 
202
     (from_list int8_signed [1;2;3;4;127;-128])));
 
203
  test 5 1 (normalize_comparison (compare
 
204
     (from_list int8_signed [1;2;3;4;127;-128])
 
205
     (from_list int8_signed [1;2;3;-4])));
 
206
 
 
207
  test 6 0 (normalize_comparison (compare
 
208
     (from_list int8_unsigned [1;2;3;-4;127;-128])
 
209
     (from_list int8_unsigned [1;2;3;-4;127;-128])));
 
210
  test 7 1 (normalize_comparison (compare
 
211
     (from_list int8_unsigned [1;2;3;-4;127;-128])
 
212
     (from_list int8_unsigned [1;2;3;4;127;-128])));
 
213
  test 8 1 (normalize_comparison (compare
 
214
     (from_list int8_unsigned [1;2;3;-4;127;-128])
 
215
     (from_list int8_unsigned [1;2;3;-4;42;-128])));
 
216
 
 
217
  test 9 0 (normalize_comparison (compare
 
218
     (from_list int16_signed [1;2;3;-4;127;-128])
 
219
     (from_list int16_signed [1;2;3;-4;127;-128])));
 
220
  test 10 (-1) (normalize_comparison (compare
 
221
     (from_list int16_signed [1;2;3;-4;127;-128])
 
222
     (from_list int16_signed [1;2;3;4;127;-128])));
 
223
  test 11 1 (normalize_comparison (compare
 
224
     (from_list int16_signed [1;2;3;-4;127;-128])
 
225
     (from_list int16_signed [1;2;3;-4;42;-128])));
 
226
 
 
227
  test 12 0 (normalize_comparison (compare
 
228
     (from_list int16_unsigned [1;2;3;-4;127;-128])
 
229
     (from_list int16_unsigned [1;2;3;-4;127;-128])));
 
230
  test 13 (-1) (normalize_comparison (compare
 
231
     (from_list int16_unsigned [1;2;3;4;127;-128])
 
232
     (from_list int16_unsigned [1;2;3;0xFFFF;127;-128])));
 
233
  test 14 1 (normalize_comparison (compare
 
234
     (from_list int16_unsigned [1;2;3;-4;127;-128])
 
235
     (from_list int16_unsigned [1;2;3;-4;42;-128])));
 
236
 
 
237
  test 15 0 (normalize_comparison (compare
 
238
     (from_list int [1;2;3;-4;127;-128])
 
239
     (from_list int [1;2;3;-4;127;-128])));
 
240
  test 16 (-1) (normalize_comparison (compare
 
241
     (from_list int [1;2;3;-4;127;-128])
 
242
     (from_list int [1;2;3;4;127;-128])));
 
243
  test 17 1 (normalize_comparison (compare
 
244
     (from_list int [1;2;3;-4;127;-128])
 
245
     (from_list int [1;2;3;-4;42;-128])));
 
246
 
 
247
  test 18 0 (normalize_comparison (compare
 
248
     (from_list int32 (List.map Int32.of_int [1;2;3;-4;127;-128]))
 
249
     (from_list int32 (List.map Int32.of_int [1;2;3;-4;127;-128]))));
 
250
  test 19 (-1) (normalize_comparison (compare
 
251
     (from_list int32 (List.map Int32.of_int [1;2;3;-4;127;-128]))
 
252
     (from_list int32 (List.map Int32.of_int [1;2;3;4;127;-128]))));
 
253
  test 20 1 (normalize_comparison (compare
 
254
     (from_list int32 (List.map Int32.of_int [1;2;3;-4;127;-128]))
 
255
     (from_list int32 (List.map Int32.of_int [1;2;3;-4;42;-128]))));
 
256
 
 
257
  test 21 0 (normalize_comparison (compare
 
258
     (from_list int64 (List.map Int64.of_int [1;2;3;-4;127;-128]))
 
259
     (from_list int64 (List.map Int64.of_int [1;2;3;-4;127;-128]))));
 
260
  test 22 (-1) (normalize_comparison (compare
 
261
     (from_list int64 (List.map Int64.of_int [1;2;3;-4;127;-128]))
 
262
     (from_list int64 (List.map Int64.of_int [1;2;3;4;127;-128]))));
 
263
  test 23 1 (normalize_comparison (compare
 
264
     (from_list int64 (List.map Int64.of_int [1;2;3;-4;127;-128]))
 
265
     (from_list int64 (List.map Int64.of_int [1;2;3;-4;42;-128]))));
 
266
 
 
267
  test 24 0 (normalize_comparison (compare
 
268
     (from_list nativeint (List.map Nativeint.of_int [1;2;3;-4;127;-128]))
 
269
     (from_list nativeint (List.map Nativeint.of_int [1;2;3;-4;127;-128]))));
 
270
  test 25 (-1) (normalize_comparison (compare
 
271
     (from_list nativeint (List.map Nativeint.of_int [1;2;3;-4;127;-128]))
 
272
     (from_list nativeint (List.map Nativeint.of_int [1;2;3;4;127;-128]))));
 
273
  test 26 1 (normalize_comparison (compare
 
274
     (from_list nativeint (List.map Nativeint.of_int [1;2;3;-4;127;-128]))
 
275
     (from_list nativeint (List.map Nativeint.of_int [1;2;3;-4;42;-128]))));
 
276
 
 
277
  test 27 0 (normalize_comparison (compare
 
278
     (from_list float32 [0.0; 0.25; -4.0; 3.141592654])
 
279
     (from_list float32 [0.0; 0.25; -4.0; 3.141592654])));
 
280
  test 28 (-1) (normalize_comparison (compare
 
281
     (from_list float32 [0.0; 0.25; -4.0])
 
282
     (from_list float32 [0.0; 0.25; 3.14159])));
 
283
  test 29 1 (normalize_comparison (compare
 
284
     (from_list float32 [0.0; 2.718; -4.0])
 
285
     (from_list float32 [0.0; 0.25; 3.14159])));
 
286
 
 
287
  test 30 0 (normalize_comparison (compare
 
288
     (from_list float64 [0.0; 0.25; -4.0; 3.141592654])
 
289
     (from_list float64 [0.0; 0.25; -4.0; 3.141592654])));
 
290
  test 31 (-1) (normalize_comparison (compare
 
291
     (from_list float64 [0.0; 0.25; -4.0])
 
292
     (from_list float64 [0.0; 0.25; 3.14159])));
 
293
  test 32 1 (normalize_comparison (compare
 
294
     (from_list float64 [0.0; 2.718; -4.0])
 
295
     (from_list float64 [0.0; 0.25; 3.14159])));
 
296
 
 
297
  test 44 0 (normalize_comparison (compare
 
298
     (from_list complex32 [Complex.zero; Complex.one; Complex.i])
 
299
     (from_list complex32 [Complex.zero; Complex.one; Complex.i])));
 
300
  test 45 (-1) (normalize_comparison (compare
 
301
     (from_list complex32 [Complex.zero; Complex.one; Complex.i])
 
302
     (from_list complex32 [Complex.zero; Complex.one; Complex.one])));
 
303
  test 46 1 (normalize_comparison (compare
 
304
     (from_list complex32 [Complex.zero; Complex.one; Complex.one])
 
305
     (from_list complex32 [Complex.zero; Complex.one; Complex.i])));
 
306
 
 
307
  test 47 0 (normalize_comparison (compare
 
308
     (from_list complex64 [Complex.zero; Complex.one; Complex.i])
 
309
     (from_list complex64 [Complex.zero; Complex.one; Complex.i])));
 
310
  test 48 (-1) (normalize_comparison (compare
 
311
     (from_list complex64 [Complex.zero; Complex.one; Complex.i])
 
312
     (from_list complex64 [Complex.zero; Complex.one; Complex.one])));
 
313
  test 49 1 (normalize_comparison (compare
 
314
     (from_list complex64 [Complex.zero; Complex.one; Complex.one])
 
315
     (from_list complex64 [Complex.zero; Complex.one; Complex.i])));
 
316
 
 
317
  testing_function "dim";
 
318
  test 1 (Array1.dim (from_list int [1;2;3;4;5])) 5;
 
319
  test 2 (Array1.dim (from_list_fortran int [1;2;3])) 3;
 
320
 
 
321
  testing_function "kind & layout";
 
322
  let a = from_list int [1;2;3] in
 
323
  test 1 (Array1.kind a) int;
 
324
  test 2 (Array1.layout a) c_layout;
 
325
  let a = from_list_fortran float32 [1.0;2.0;3.0] in
 
326
  test 1 (Array1.kind a) float32;
 
327
  test 2 (Array1.layout a) fortran_layout;
 
328
 
 
329
  testing_function "sub";
 
330
  let a = from_list int [1;2;3;4;5;6;7;8] in
 
331
  test 1 (Array1.sub a 2 5)
 
332
         (from_list int [3;4;5;6;7]);
 
333
  test 2 (Array1.sub a 0 2)
 
334
         (from_list int [1;2]);
 
335
  test 3 (Array1.sub a 0 8)
 
336
         (from_list int [1;2;3;4;5;6;7;8]);
 
337
  let a = from_list float64 [1.0;2.0;3.0;4.0;5.0;6.0;7.0;8.0] in
 
338
  test 4 (Array1.sub a 2 5)
 
339
         (from_list float64 [3.0;4.0;5.0;6.0;7.0]);
 
340
  test 5 (Array1.sub a 0 2)
 
341
         (from_list float64 [1.0;2.0]);
 
342
  test 6 (Array1.sub a 0 8)
 
343
         (from_list float64 [1.0;2.0;3.0;4.0;5.0;6.0;7.0;8.0]);
 
344
  let a = from_list_fortran float64 [1.0;2.0;3.0;4.0;5.0;6.0;7.0;8.0] in
 
345
  test 7 (Array1.sub a 2 5)
 
346
         (from_list_fortran float64 [2.0;3.0;4.0;5.0;6.0]);
 
347
  test 8 (Array1.sub a 1 2)
 
348
         (from_list_fortran float64 [1.0;2.0]);
 
349
  test 9 (Array1.sub a 1 8)
 
350
         (from_list_fortran float64 [1.0;2.0;3.0;4.0;5.0;6.0;7.0;8.0]);
 
351
  Gc.full_major();  (* test GC of proxies *)
 
352
 
 
353
  testing_function "blit, fill";
 
354
  let test_blit_fill kind data initval ofs len =
 
355
    let a = from_list kind data in
 
356
    let b = Array1.create kind c_layout (List.length data) in
 
357
    Array1.blit a b;
 
358
    (a = b) &&
 
359
    (Array1.fill (Array1.sub b ofs len) initval;
 
360
     let rec check i = function
 
361
         [] -> true
 
362
       | hd :: tl -> b.{i} = (if i >= ofs && i < ofs + len
 
363
                                       then initval else hd)
 
364
                     && check (i+1) tl
 
365
     in check 0 data) in
 
366
  test 1 true (test_blit_fill int8_signed [1;2;5;8;-100;127] 7 3 2);
 
367
  test 2 true (test_blit_fill int8_unsigned [1;2;5;8;-100;212] 7 3 2);
 
368
  test 3 true (test_blit_fill int16_signed [1;2;5;8;-100;212] 7 3 2);
 
369
  test 4 true (test_blit_fill int16_unsigned [1;2;5;8;-100;212] 7 3 2);
 
370
  test 5 true (test_blit_fill int [1;2;5;8;-100;212] 7 3 2);
 
371
  test 6 true (test_blit_fill int32 (List.map Int32.of_int [1;2;5;8;-100;212])
 
372
                                    (Int32.of_int 7) 3 2);
 
373
  test 7 true (test_blit_fill int64 (List.map Int64.of_int [1;2;5;8;-100;212])
 
374
                                    (Int64.of_int 7) 3 2);
 
375
  test 8 true (test_blit_fill nativeint
 
376
                             (List.map Nativeint.of_int [1;2;5;8;-100;212])
 
377
                             (Nativeint.of_int 7) 3 2);
 
378
  test 9 true (test_blit_fill float32 [1.0;2.0;0.5;0.125;256.0;512.0]
 
379
                             0.25 3 2);
 
380
  test 10 true (test_blit_fill float64 [1.0;2.0;5.0;8.123;-100.456;212e19]
 
381
                             3.1415 3 2);
 
382
  test 11 true (test_blit_fill complex32 [Complex.zero; Complex.one; Complex.i]
 
383
                             Complex.i 1 1);
 
384
  test 12 true (test_blit_fill complex64 [Complex.zero; Complex.one; Complex.i]
 
385
                             Complex.i 1 1);
 
386
 
 
387
(* Bi-dimensional arrays *)
 
388
 
 
389
  print_newline();
 
390
  testing_function "------ Array2 --------";
 
391
  testing_function "create/set/get";
 
392
  let make_array2 kind layout ind0 dim1 dim2 fromint =
 
393
    let a = Array2.create kind layout dim1 dim2 in
 
394
    for i = ind0 to dim1 - 1 + ind0 do
 
395
      for j = ind0 to dim2 - 1 + ind0 do
 
396
        a.{i,j} <- (fromint (i * 1000 + j))
 
397
      done
 
398
    done;
 
399
    a in
 
400
  let check_array2 a ind0 dim1 dim2 fromint =
 
401
    try
 
402
      for i = ind0 to dim1 - 1 + ind0 do
 
403
        for j = ind0 to dim2 - 1 + ind0 do
 
404
          if a.{i,j} <> (fromint (i * 1000 + j)) then raise Exit
 
405
        done
 
406
      done;
 
407
      true
 
408
    with Exit -> false in
 
409
  let id x = x in
 
410
  test 1 true
 
411
    (check_array2 (make_array2 int16_signed c_layout 0 10 20 id) 0 10 20 id);
 
412
  test 2 true
 
413
    (check_array2 (make_array2 int c_layout 0 10 20 id) 0 10 20 id);
 
414
  test 3 true
 
415
    (check_array2 (make_array2 int32 c_layout 0 10 20 Int32.of_int)
 
416
                  0 10 20 Int32.of_int);
 
417
  test 4 true
 
418
    (check_array2 (make_array2 float32 c_layout 0 10 20 float)
 
419
                  0 10 20 float);
 
420
  test 5 true
 
421
    (check_array2 (make_array2 float64 c_layout 0 10 20 float)
 
422
                  0 10 20 float);
 
423
  test 6 true
 
424
    (check_array2 (make_array2 int16_signed fortran_layout 1 10 20 id) 1 10 20 id);
 
425
  test 7 true
 
426
    (check_array2 (make_array2 int fortran_layout 1 10 20 id) 1 10 20 id);
 
427
  test 8 true
 
428
    (check_array2 (make_array2 int32 fortran_layout 1 10 20 Int32.of_int)
 
429
                  1 10 20 Int32.of_int);
 
430
  test 9 true
 
431
    (check_array2 (make_array2 float32 fortran_layout 1 10 20 float)
 
432
                  1 10 20 float);
 
433
  test 10 true
 
434
    (check_array2 (make_array2 float64 fortran_layout 1 10 20 float)
 
435
                  1 10 20 float);
 
436
  let makecomplex i = {re = float i; im = float (-i)} in
 
437
  test 11 true
 
438
    (check_array2 (make_array2 complex32 c_layout 0 10 20 makecomplex)
 
439
                  0 10 20 makecomplex);
 
440
  test 12 true
 
441
    (check_array2 (make_array2 complex64 c_layout 0 10 20 makecomplex)
 
442
                  0 10 20 makecomplex);
 
443
  test 13 true
 
444
    (check_array2 (make_array2 complex32 fortran_layout 1 10 20 makecomplex)
 
445
                  1 10 20 makecomplex);
 
446
  test 14 true
 
447
    (check_array2 (make_array2 complex64 fortran_layout 1 10 20 makecomplex)
 
448
                  1 10 20 makecomplex);
 
449
 
 
450
  testing_function "set/get (specialized)";
 
451
  let a = Array2.create int16_signed c_layout 3 3 in
 
452
  for i = 0 to 2 do for j = 0 to 2 do a.{i,j} <- i-j done done;
 
453
  let ok = ref true in
 
454
  for i = 0 to 2 do
 
455
    for j = 0 to 2 do if a.{i,j} <> i-j then ok := false done
 
456
  done;
 
457
  test 1 true !ok;
 
458
  test 2 true (try ignore a.{3,0}; false with Invalid_argument _ -> true);
 
459
  test 3 true (try ignore a.{-1,0}; false with Invalid_argument _ -> true);
 
460
  test 4 true (try ignore a.{0,3}; false with Invalid_argument _ -> true);
 
461
  test 5 true (try ignore a.{0,-1}; false with Invalid_argument _ -> true);
 
462
    
 
463
  let b = Array2.create float32 fortran_layout 3 3 in
 
464
  for i = 1 to 3 do for j = 1 to 3 do b.{i,j} <- float(i-j) done done;
 
465
  let ok = ref true in
 
466
  for i = 1 to 3 do
 
467
    for j = 1 to 3 do if b.{i,j} <> float(i-j) then ok := false done
 
468
  done;
 
469
  test 6 true !ok;
 
470
  test 7 true (try ignore b.{4,1}; false with Invalid_argument _ -> true);
 
471
  test 8 true (try ignore b.{0,1}; false with Invalid_argument _ -> true);
 
472
  test 9 true (try ignore b.{1,4}; false with Invalid_argument _ -> true);
 
473
  test 10 true (try ignore b.{1,0}; false with Invalid_argument _ -> true);
 
474
 
 
475
  testing_function "set/get (unsafe, specialized)";
 
476
  let a = Array2.create int16_signed c_layout 3 3 in
 
477
  for i = 0 to 2 do for j = 0 to 2 do Array2.unsafe_set a i j (i-j) done done;
 
478
  let ok = ref true in
 
479
  for i = 0 to 2 do
 
480
    for j = 0 to 2 do if Array2.unsafe_get a i j <> i-j then ok := false done
 
481
  done;
 
482
  test 1 true !ok;
 
483
    
 
484
  let b = Array2.create float32 fortran_layout 3 3 in
 
485
  for i = 1 to 3 do for j = 1 to 3 do Array2.unsafe_set b i j (float(i-j)) done done;
 
486
  let ok = ref true in
 
487
  for i = 1 to 3 do
 
488
    for j = 1 to 3 do if Array2.unsafe_get b i j <> float(i-j) then ok := false done
 
489
  done;
 
490
  test 2 true !ok;
 
491
 
 
492
  testing_function "dim";
 
493
  let a = (make_array2 int c_layout 0 4 6 id) in
 
494
  test 1 (Array2.dim1 a) 4;
 
495
  test 2 (Array2.dim2 a) 6;
 
496
  let b =  (make_array2 int fortran_layout 1 4 6 id) in
 
497
  test 3 (Array2.dim1 b) 4;
 
498
  test 4 (Array2.dim2 b) 6;
 
499
 
 
500
  testing_function "sub";
 
501
  let a = make_array2 int c_layout 0 5 3 id in
 
502
  let b = Array2.sub_left a 2 2 in
 
503
  test 1 true
 
504
         (b.{0,0} = 2000 &&
 
505
          b.{0,1} = 2001 &&
 
506
          b.{0,2} = 2002 &&
 
507
          b.{1,0} = 3000 &&
 
508
          b.{1,1} = 3001 &&
 
509
          b.{1,2} = 3002);
 
510
  let a = make_array2 int fortran_layout 1 5 3 id in
 
511
  let b = Array2.sub_right a 2 2 in
 
512
  test 2 true
 
513
         (b.{1,1} = 1002 &&
 
514
          b.{1,2} = 1003 &&
 
515
          b.{2,1} = 2002 &&
 
516
          b.{2,2} = 2003 &&
 
517
          b.{3,1} = 3002 &&
 
518
          b.{3,2} = 3003 &&
 
519
          b.{4,1} = 4002 &&
 
520
          b.{4,2} = 4003 &&
 
521
          b.{5,1} = 5002 &&
 
522
          b.{5,2} = 5003);
 
523
 
 
524
  testing_function "slice";
 
525
  let a = make_array2 int c_layout 0 5 3 id in
 
526
  test 1 (Array2.slice_left a 0) (from_list int [0;1;2]);
 
527
  test 2 (Array2.slice_left a 1) (from_list int [1000;1001;1002]);
 
528
  test 3 (Array2.slice_left a 2) (from_list int [2000;2001;2002]);
 
529
  test 4 (Array2.slice_left a 3) (from_list int [3000;3001;3002]);
 
530
  test 5 (Array2.slice_left a 4) (from_list int [4000;4001;4002]);
 
531
  let a = make_array2 int fortran_layout 1 5 3 id in
 
532
  test 6 (Array2.slice_right a 1) (from_list_fortran int [1001;2001;3001;4001;5001]);
 
533
  test 7 (Array2.slice_right a 2) (from_list_fortran int [1002;2002;3002;4002;5002]);
 
534
  test 8 (Array2.slice_right a 3) (from_list_fortran int [1003;2003;3003;4003;5003]);
 
535
 
 
536
(* Tri-dimensional arrays *)
 
537
 
 
538
  print_newline();
 
539
  testing_function "------ Array3 --------";
 
540
  testing_function "create/set/get";
 
541
  let make_array3 kind layout ind0 dim1 dim2 dim3 fromint =
 
542
    let a = Array3.create kind layout dim1 dim2 dim3 in
 
543
    for i = ind0 to dim1 - 1 + ind0 do
 
544
      for j = ind0 to dim2 - 1 + ind0 do
 
545
        for k = ind0 to dim3 - 1 + ind0 do
 
546
          a.{i, j, k} <- (fromint (i * 100 + j * 10 + k))
 
547
        done
 
548
      done
 
549
    done;
 
550
    a in
 
551
  let check_array3 a ind0 dim1 dim2 dim3 fromint =
 
552
    try
 
553
      for i = ind0 to dim1 - 1 + ind0 do
 
554
        for j = ind0 to dim2 - 1 + ind0 do
 
555
          for k = ind0 to dim3 - 1 + ind0 do
 
556
            if a.{i, j, k} <> (fromint (i * 100 + j * 10 + k))
 
557
            then raise Exit
 
558
          done
 
559
        done
 
560
      done;
 
561
      true
 
562
    with Exit -> false in
 
563
  let id x = x in
 
564
  test 1 true
 
565
    (check_array3 (make_array3 int16_signed c_layout 0 4 5 6 id) 0 4 5 6 id);
 
566
  test 2 true
 
567
    (check_array3 (make_array3 int c_layout 0 4 5 6 id) 0 4 5 6 id);
 
568
  test 3 true
 
569
    (check_array3 (make_array3 int32 c_layout 0 4 5 6 Int32.of_int)
 
570
                  0 4 5 6 Int32.of_int);
 
571
  test 4 true
 
572
    (check_array3 (make_array3 float32 c_layout 0 4 5 6 float)
 
573
                  0 4 5 6 float);
 
574
  test 5 true
 
575
    (check_array3 (make_array3 float64 c_layout 0 4 5 6 float)
 
576
                  0 4 5 6 float);
 
577
  test 6 true
 
578
    (check_array3 (make_array3 int16_signed fortran_layout 1 4 5 6 id) 1 4 5 6 id);
 
579
  test 7 true
 
580
    (check_array3 (make_array3 int fortran_layout 1 4 5 6 id) 1 4 5 6 id);
 
581
  test 8 true
 
582
    (check_array3 (make_array3 int32 fortran_layout 1 4 5 6 Int32.of_int)
 
583
                  1 4 5 6 Int32.of_int);
 
584
  test 9 true
 
585
    (check_array3 (make_array3 float32 fortran_layout 1 4 5 6 float)
 
586
                  1 4 5 6 float);
 
587
  test 10 true
 
588
    (check_array3 (make_array3 float64 fortran_layout 1 4 5 6 float)
 
589
                  1 4 5 6 float);
 
590
  test 11 true
 
591
    (check_array3 (make_array3 complex32 c_layout 0 4 5 6 makecomplex)
 
592
                  0 4 5 6 makecomplex);
 
593
  test 12 true
 
594
    (check_array3 (make_array3 complex64 c_layout 0 4 5 6 makecomplex)
 
595
                  0 4 5 6 makecomplex);
 
596
  test 13 true
 
597
    (check_array3 (make_array3 complex32 fortran_layout 1 4 5 6 makecomplex)
 
598
                  1 4 5 6 makecomplex);
 
599
  test 14 true
 
600
    (check_array3 (make_array3 complex64 fortran_layout 1 4 5 6 makecomplex)
 
601
                  1 4 5 6 makecomplex);
 
602
 
 
603
 
 
604
  testing_function "set/get (specialized)";
 
605
  let a = Array3.create int32 c_layout 2 3 4 in
 
606
  for i = 0 to 1 do for j = 0 to 2 do for k = 0 to 3 do
 
607
     a.{i,j,k} <- Int32.of_int((i lsl 4) + (j lsl 2) + k)
 
608
  done done done;
 
609
  let ok = ref true in
 
610
  for i = 0 to 1 do for j = 0 to 2 do for k = 0 to 3 do
 
611
     if Int32.to_int a.{i,j,k} <> (i lsl 4) + (j lsl 2) + k then ok := false
 
612
  done done done;
 
613
  test 1 true !ok;
 
614
    
 
615
  let b = Array3.create int64 fortran_layout 2 3 4 in
 
616
  for i = 1 to 2 do for j = 1 to 3 do for k = 1 to 4 do
 
617
     b.{i,j,k} <- Int64.of_int((i lsl 4) + (j lsl 2) + k)
 
618
  done done done;
 
619
  let ok = ref true in
 
620
  for i = 1 to 2 do for j = 1 to 3 do for k = 1 to 4 do
 
621
     if Int64.to_int b.{i,j,k} <> (i lsl 4) + (j lsl 2) + k then ok := false
 
622
  done done done;
 
623
  test 2 true !ok;
 
624
 
 
625
  testing_function "set/get (unsafe, specialized)";
 
626
  let a = Array3.create int32 c_layout 2 3 4 in
 
627
  for i = 0 to 1 do for j = 0 to 2 do for k = 0 to 3 do
 
628
     Array3.unsafe_set a i j k (Int32.of_int((i lsl 4) + (j lsl 2) + k))
 
629
  done done done;
 
630
  let ok = ref true in
 
631
  for i = 0 to 1 do for j = 0 to 2 do for k = 0 to 3 do
 
632
     if Int32.to_int (Array3.unsafe_get a i j k) <> (i lsl 4) + (j lsl 2) + k then ok := false
 
633
  done done done;
 
634
  test 1 true !ok;
 
635
 
 
636
  testing_function "dim";
 
637
  let a = (make_array3 int c_layout 0 4 5 6 id) in
 
638
  test 1 (Array3.dim1 a) 4;
 
639
  test 2 (Array3.dim2 a) 5;
 
640
  test 3 (Array3.dim3 a) 6;
 
641
  let b =  (make_array3 int fortran_layout 1 4 5 6 id) in
 
642
  test 4 (Array3.dim1 b) 4;
 
643
  test 5 (Array3.dim2 b) 5;
 
644
  test 6 (Array3.dim3 b) 6;
 
645
 
 
646
  testing_function "slice1";
 
647
  let a = make_array3 int c_layout 0 3 3 3 id in
 
648
  test 1 (Array3.slice_left_1 a 0 0) (from_list int [0;1;2]);
 
649
  test 2 (Array3.slice_left_1 a 0 1) (from_list int [10;11;12]);
 
650
  test 3 (Array3.slice_left_1 a 0 2) (from_list int [20;21;22]);
 
651
  test 4 (Array3.slice_left_1 a 1 1) (from_list int [110;111;112]);
 
652
  test 5 (Array3.slice_left_1 a 2 1) (from_list int [210;211;212]);
 
653
  let a = make_array3 int fortran_layout 1 3 3 3 id in
 
654
  test 6 (Array3.slice_right_1 a 1 2) (from_list_fortran int [112;212;312]);
 
655
  test 7 (Array3.slice_right_1 a 3 1) (from_list_fortran int [131;231;331]);
 
656
 
 
657
(* Reshaping *)
 
658
  print_newline();
 
659
  testing_function "------ Reshaping --------";
 
660
  testing_function "reshape_1";
 
661
  let a = make_array2 int c_layout 0 3 4 id in
 
662
  let b = make_array2 int fortran_layout 1 3 4 id in
 
663
  let c = reshape_1 (genarray_of_array2 a) 12 in
 
664
  test 1 c (from_list int [0;1;2;3;1000;1001;1002;1003;2000;2001;2002;2003]);
 
665
  let d = reshape_1 (genarray_of_array2 b) 12 in
 
666
  test 2 d (from_list_fortran int [1001;2001;3001;1002;2002;3002;1003;2003;3003;1004;2004;3004]);
 
667
  testing_function "reshape_2";
 
668
  let c = reshape_2 (genarray_of_array2 a) 4 3 in
 
669
  test 1 (Array2.slice_left c 0) (from_list int [0;1;2]);
 
670
  test 2 (Array2.slice_left c 1) (from_list int [3;1000;1001]);
 
671
  test 3 (Array2.slice_left c 2) (from_list int [1002;1003;2000]);
 
672
  test 4 (Array2.slice_left c 3) (from_list int [2001;2002;2003]);
 
673
  let d = reshape_2 (genarray_of_array2 b) 4 3 in
 
674
  test 5 (Array2.slice_right d 1) (from_list_fortran int [1001;2001;3001;1002]);
 
675
  test 6 (Array2.slice_right d 2) (from_list_fortran int [2002;3002;1003;2003]);
 
676
  test 7 (Array2.slice_right d 3) (from_list_fortran int [3003;1004;2004;3004]);
 
677
 
 
678
(* I/O *)
 
679
 
 
680
  print_newline();
 
681
  testing_function "------ I/O --------";
 
682
  testing_function "output_value/input_value";
 
683
  let test_structured_io testno value =
 
684
    let tmp = Filename.temp_file "bigarray" ".data" in
 
685
    let oc = open_out_bin tmp in
 
686
    output_value oc value;
 
687
    close_out oc;
 
688
    let ic = open_in_bin tmp in
 
689
    let value' = input_value ic in
 
690
    close_in ic;
 
691
    Sys.remove tmp;
 
692
    test testno value value' in
 
693
  test_structured_io 1 (from_list int8_signed [1;2;3;-4;127;-128]);
 
694
  test_structured_io 2 (from_list int16_signed [1;2;3;-4;127;-128]);
 
695
  test_structured_io 3 (from_list int [1;2;3;-4;127;-128]);
 
696
  test_structured_io 4
 
697
    (from_list int32 (List.map Int32.of_int [1;2;3;-4;127;-128]));
 
698
  test_structured_io 5
 
699
    (from_list int64 (List.map Int64.of_int [1;2;3;-4;127;-128]));
 
700
  test_structured_io 6
 
701
    (from_list nativeint (List.map Nativeint.of_int [1;2;3;-4;127;-128]));
 
702
  test_structured_io 7 (from_list float32 [0.0; 0.25; -4.0; 3.141592654]);
 
703
  test_structured_io 8 (from_list float64 [0.0; 0.25; -4.0; 3.141592654]);
 
704
  test_structured_io 9 (make_array2 int c_layout 0 100 100 id);
 
705
  test_structured_io 10 (make_array2 float64 fortran_layout 1 200 200 float);
 
706
  test_structured_io 11 (make_array3 int32 c_layout 0 20 30 40 Int32.of_int);
 
707
  test_structured_io 12 (make_array3 float32 fortran_layout 1 10 50 100 float);
 
708
  test_structured_io 13 (make_array2 complex32 c_layout 0 100 100 makecomplex);
 
709
  test_structured_io 14 (make_array3 complex64 fortran_layout 1 10 20 30 makecomplex);
 
710
 
 
711
  testing_function "map_file";
 
712
  let mapped_file = Filename.temp_file "bigarray" ".data" in
 
713
  begin
 
714
    let fd =
 
715
     Unix.openfile mapped_file
 
716
                   [Unix.O_RDWR; Unix.O_TRUNC; Unix.O_CREAT] 0o666 in
 
717
    let a = Array1.map_file fd float64 c_layout true 10000 in
 
718
    Unix.close fd;
 
719
    for i = 0 to 9999 do a.{i} <- float i done;
 
720
    let fd = Unix.openfile mapped_file [Unix.O_RDONLY] 0 in
 
721
    let b = Array2.map_file fd float64 fortran_layout false 100 (-1) in
 
722
    Unix.close fd;
 
723
    let ok = ref true in
 
724
    for i = 0 to 99 do
 
725
      for j = 0 to 99 do
 
726
        if b.{j+1,i+1} <> float (100 * i + j) then ok := false
 
727
      done
 
728
    done;
 
729
    test 1 !ok true;
 
730
    b.{50,50} <- (-1.0);
 
731
    let fd = Unix.openfile mapped_file [Unix.O_RDONLY] 0 in
 
732
    let c = Array2.map_file fd float64 c_layout false (-1) 100 in
 
733
    Unix.close fd;
 
734
    let ok = ref true in
 
735
    for i = 0 to 99 do
 
736
      for j = 0 to 99 do
 
737
        if c.{i,j} <> float (100 * i + j) then ok := false
 
738
      done
 
739
    done;
 
740
    test 2 !ok true;
 
741
    let fd = Unix.openfile mapped_file [Unix.O_RDONLY] 0 in
 
742
    let c = Array2.map_file fd ~pos:800L float64 c_layout false (-1) 100 in
 
743
    Unix.close fd;
 
744
    let ok = ref true in
 
745
    for i = 1 to 99 do
 
746
      for j = 0 to 99 do
 
747
        if c.{i-1,j} <> float (100 * i + j) then ok := false
 
748
      done
 
749
    done;
 
750
    test 3 !ok true;
 
751
    let fd = Unix.openfile mapped_file [Unix.O_RDONLY] 0 in
 
752
    let c = Array2.map_file fd ~pos:79200L float64 c_layout false (-1) 100 in
 
753
    Unix.close fd;
 
754
    let ok = ref true in
 
755
    for j = 0 to 99 do
 
756
      if c.{0,j} <> float (100 * 99 + j) then ok := false
 
757
    done;
 
758
    test 4 !ok true
 
759
  end;
 
760
  (* Force garbage collection of the mapped bigarrays above, otherwise
 
761
     Win32 doesn't let us erase the file.  Notice the begin...end above
 
762
     so that the VM doesn't keep stack references to the mapped bigarrays. *)
 
763
  Gc.full_major();
 
764
  Sys.remove mapped_file;
 
765
 
 
766
  ()
 
767
                  
 
768
(********* End of test *********)
 
769
 
 
770
let _ =
 
771
  print_newline();
 
772
  if !error_occurred then begin
 
773
    prerr_endline "************* TEST FAILED ****************"; exit 2
 
774
  end else
 
775
    exit 0