635 lines
24 KiB
OCaml
635 lines
24 KiB
OCaml
open Bigarray
|
|
open Printf
|
|
|
|
(* Test harness *)
|
|
|
|
let error_occurred = ref false
|
|
|
|
let function_tested = ref ""
|
|
|
|
let testing_function s =
|
|
function_tested := s;
|
|
print_newline();
|
|
print_string s;
|
|
print_newline()
|
|
|
|
let test test_number answer correct_answer =
|
|
flush stdout;
|
|
flush stderr;
|
|
if answer <> correct_answer then begin
|
|
eprintf "*** Bad result (%s, test %d)\n" !function_tested test_number;
|
|
flush stderr;
|
|
error_occurred := true
|
|
end else begin
|
|
printf " %d..." test_number
|
|
end
|
|
|
|
(* One-dimensional arrays *)
|
|
|
|
let _ =
|
|
testing_function "------ Array1 --------";
|
|
testing_function "create/set/get";
|
|
let test_setget kind vals =
|
|
let rec set a i = function
|
|
[] -> ()
|
|
| (v1, v2) :: tl -> a.{i} <- v1; set a (i+1) tl in
|
|
let rec test a i = function
|
|
[] -> true
|
|
| (v1, v2) :: tl -> a.{i} = v2 && test a (i+1) tl in
|
|
let ca = Array1.create kind c_layout (List.length vals) in
|
|
let fa = Array1.create kind fortran_layout (List.length vals) in
|
|
set ca 0 vals;
|
|
set fa 1 vals;
|
|
test ca 0 vals && test fa 1 vals in
|
|
test 1 true
|
|
(test_setget int8_signed
|
|
[0, 0;
|
|
123, 123;
|
|
-123, -123;
|
|
456, -56;
|
|
0x101, 1]);
|
|
test 2 true
|
|
(test_setget int8_unsigned
|
|
[0, 0;
|
|
123, 123;
|
|
-123, 133;
|
|
456, 0xc8;
|
|
0x101, 1]);
|
|
test 3 true
|
|
(test_setget int16_signed
|
|
[0, 0;
|
|
123, 123;
|
|
-123, -123;
|
|
31456, 31456;
|
|
-31456, -31456;
|
|
65432, -104;
|
|
0x10001, 1]);
|
|
test 4 true
|
|
(test_setget int16_unsigned
|
|
[0, 0;
|
|
123, 123;
|
|
-123, 65413;
|
|
31456, 31456;
|
|
-31456, 34080;
|
|
65432, 65432;
|
|
0x10001, 1]);
|
|
test 5 true
|
|
(test_setget int
|
|
[0, 0;
|
|
123, 123;
|
|
-456, -456;
|
|
max_int, max_int;
|
|
min_int, min_int;
|
|
0x12345678, 0x12345678;
|
|
-0x12345678, -0x12345678]);
|
|
test 6 true
|
|
(test_setget int32
|
|
[Int32.zero, Int32.zero;
|
|
Int32.of_int 123, Int32.of_int 123;
|
|
Int32.of_int (-456), Int32.of_int (-456);
|
|
Int32.max_int, Int32.max_int;
|
|
Int32.min_int, Int32.min_int;
|
|
Int32.of_string "0x12345678", Int32.of_string "0x12345678"]);
|
|
test 7 true
|
|
(test_setget int64
|
|
[Int64.zero, Int64.zero;
|
|
Int64.of_int 123, Int64.of_int 123;
|
|
Int64.of_int (-456), Int64.of_int (-456);
|
|
Int64.max_int, Int64.max_int;
|
|
Int64.min_int, Int64.min_int;
|
|
Int64.of_string "0x123456789ABCDEF0",
|
|
Int64.of_string "0x123456789ABCDEF0"]);
|
|
test 8 true
|
|
(test_setget nativeint
|
|
[Nativeint.zero, Nativeint.zero;
|
|
Nativeint.of_int 123, Nativeint.of_int 123;
|
|
Nativeint.of_int (-456), Nativeint.of_int (-456);
|
|
Nativeint.max_int, Nativeint.max_int;
|
|
Nativeint.min_int, Nativeint.min_int;
|
|
Nativeint.of_string "0x12345678",
|
|
Nativeint.of_string "0x12345678"]);
|
|
test 9 true
|
|
(test_setget float32
|
|
[0.0, 0.0;
|
|
4.0, 4.0;
|
|
-0.5, -0.5;
|
|
655360.0, 655360.0]);
|
|
test 10 true
|
|
(test_setget float64
|
|
[0.0, 0.0;
|
|
4.0, 4.0;
|
|
-0.5, -0.5;
|
|
1.2345678, 1.2345678;
|
|
3.1415e10, 3.1415e10]);
|
|
|
|
let from_list kind vals =
|
|
let a = Array1.create kind c_layout (List.length vals) in
|
|
let rec set i = function
|
|
[] -> ()
|
|
| hd :: tl -> a.{i} <- hd; set (i+1) tl in
|
|
set 0 vals;
|
|
a in
|
|
let from_list_fortran kind vals =
|
|
let a = Array1.create kind fortran_layout (List.length vals) in
|
|
let rec set i = function
|
|
[] -> ()
|
|
| hd :: tl -> a.{i} <- hd; set (i+1) tl in
|
|
set 1 vals;
|
|
a in
|
|
|
|
testing_function "set/get (specialized)";
|
|
let a = Array1.create int c_layout 3 in
|
|
for i = 0 to 2 do a.{i} <- i done;
|
|
for i = 0 to 2 do test (i+1) a.{i} i done;
|
|
test 4 true (try a.{3}; false with Invalid_argument _ -> true);
|
|
test 5 true (try a.{-1}; false with Invalid_argument _ -> true);
|
|
|
|
let b = Array1.create float64 fortran_layout 3 in
|
|
for i = 1 to 3 do b.{i} <- float i done;
|
|
for i = 1 to 3 do test (5 + i) b.{i} (float i) done;
|
|
test 8 true (try b.{4}; false with Invalid_argument _ -> true);
|
|
test 9 true (try b.{0}; false with Invalid_argument _ -> true);
|
|
|
|
testing_function "comparisons";
|
|
let normalize_comparison n =
|
|
if n = 0 then 0 else if n < 0 then -1 else 1 in
|
|
test 1 0 (normalize_comparison (compare
|
|
(from_list int8_signed [1;2;3;-4;127;-128])
|
|
(from_list int8_signed [1;2;3;-4;127;-128])));
|
|
test 2 (-1) (normalize_comparison (compare
|
|
(from_list int8_signed [1;2;3;-4;127;-128])
|
|
(from_list int8_signed [1;2;3;4;127;-128])));
|
|
test 3 1 (normalize_comparison (compare
|
|
(from_list int8_signed [1;2;3;-4;127;-128])
|
|
(from_list int8_signed [1;2;3;-4;42;-128])));
|
|
test 4 (-1) (normalize_comparison (compare
|
|
(from_list int8_signed [1;2;3;-4])
|
|
(from_list int8_signed [1;2;3;4;127;-128])));
|
|
test 5 1 (normalize_comparison (compare
|
|
(from_list int8_signed [1;2;3;4;127;-128])
|
|
(from_list int8_signed [1;2;3;-4])));
|
|
|
|
test 6 0 (normalize_comparison (compare
|
|
(from_list int8_unsigned [1;2;3;-4;127;-128])
|
|
(from_list int8_unsigned [1;2;3;-4;127;-128])));
|
|
test 7 1 (normalize_comparison (compare
|
|
(from_list int8_unsigned [1;2;3;-4;127;-128])
|
|
(from_list int8_unsigned [1;2;3;4;127;-128])));
|
|
test 8 1 (normalize_comparison (compare
|
|
(from_list int8_unsigned [1;2;3;-4;127;-128])
|
|
(from_list int8_unsigned [1;2;3;-4;42;-128])));
|
|
|
|
test 9 0 (normalize_comparison (compare
|
|
(from_list int16_signed [1;2;3;-4;127;-128])
|
|
(from_list int16_signed [1;2;3;-4;127;-128])));
|
|
test 10 (-1) (normalize_comparison (compare
|
|
(from_list int16_signed [1;2;3;-4;127;-128])
|
|
(from_list int16_signed [1;2;3;4;127;-128])));
|
|
test 11 1 (normalize_comparison (compare
|
|
(from_list int16_signed [1;2;3;-4;127;-128])
|
|
(from_list int16_signed [1;2;3;-4;42;-128])));
|
|
|
|
test 12 0 (normalize_comparison (compare
|
|
(from_list int16_unsigned [1;2;3;-4;127;-128])
|
|
(from_list int16_unsigned [1;2;3;-4;127;-128])));
|
|
test 13 (-1) (normalize_comparison (compare
|
|
(from_list int16_unsigned [1;2;3;4;127;-128])
|
|
(from_list int16_unsigned [1;2;3;0xFFFF;127;-128])));
|
|
test 14 1 (normalize_comparison (compare
|
|
(from_list int16_unsigned [1;2;3;-4;127;-128])
|
|
(from_list int16_unsigned [1;2;3;-4;42;-128])));
|
|
|
|
test 15 0 (normalize_comparison (compare
|
|
(from_list int [1;2;3;-4;127;-128])
|
|
(from_list int [1;2;3;-4;127;-128])));
|
|
test 16 (-1) (normalize_comparison (compare
|
|
(from_list int [1;2;3;-4;127;-128])
|
|
(from_list int [1;2;3;4;127;-128])));
|
|
test 17 1 (normalize_comparison (compare
|
|
(from_list int [1;2;3;-4;127;-128])
|
|
(from_list int [1;2;3;-4;42;-128])));
|
|
|
|
test 18 0 (normalize_comparison (compare
|
|
(from_list int32 (List.map Int32.of_int [1;2;3;-4;127;-128]))
|
|
(from_list int32 (List.map Int32.of_int [1;2;3;-4;127;-128]))));
|
|
test 19 (-1) (normalize_comparison (compare
|
|
(from_list int32 (List.map Int32.of_int [1;2;3;-4;127;-128]))
|
|
(from_list int32 (List.map Int32.of_int [1;2;3;4;127;-128]))));
|
|
test 20 1 (normalize_comparison (compare
|
|
(from_list int32 (List.map Int32.of_int [1;2;3;-4;127;-128]))
|
|
(from_list int32 (List.map Int32.of_int [1;2;3;-4;42;-128]))));
|
|
|
|
test 21 0 (normalize_comparison (compare
|
|
(from_list int64 (List.map Int64.of_int [1;2;3;-4;127;-128]))
|
|
(from_list int64 (List.map Int64.of_int [1;2;3;-4;127;-128]))));
|
|
test 22 (-1) (normalize_comparison (compare
|
|
(from_list int64 (List.map Int64.of_int [1;2;3;-4;127;-128]))
|
|
(from_list int64 (List.map Int64.of_int [1;2;3;4;127;-128]))));
|
|
test 23 1 (normalize_comparison (compare
|
|
(from_list int64 (List.map Int64.of_int [1;2;3;-4;127;-128]))
|
|
(from_list int64 (List.map Int64.of_int [1;2;3;-4;42;-128]))));
|
|
|
|
test 24 0 (normalize_comparison (compare
|
|
(from_list nativeint (List.map Nativeint.of_int [1;2;3;-4;127;-128]))
|
|
(from_list nativeint (List.map Nativeint.of_int [1;2;3;-4;127;-128]))));
|
|
test 25 (-1) (normalize_comparison (compare
|
|
(from_list nativeint (List.map Nativeint.of_int [1;2;3;-4;127;-128]))
|
|
(from_list nativeint (List.map Nativeint.of_int [1;2;3;4;127;-128]))));
|
|
test 26 1 (normalize_comparison (compare
|
|
(from_list nativeint (List.map Nativeint.of_int [1;2;3;-4;127;-128]))
|
|
(from_list nativeint (List.map Nativeint.of_int [1;2;3;-4;42;-128]))));
|
|
|
|
test 27 0 (normalize_comparison (compare
|
|
(from_list float32 [0.0; 0.25; -4.0; 3.141592654])
|
|
(from_list float32 [0.0; 0.25; -4.0; 3.141592654])));
|
|
test 28 (-1) (normalize_comparison (compare
|
|
(from_list float32 [0.0; 0.25; -4.0])
|
|
(from_list float32 [0.0; 0.25; 3.14159])));
|
|
test 29 1 (normalize_comparison (compare
|
|
(from_list float32 [0.0; 2.718; -4.0])
|
|
(from_list float32 [0.0; 0.25; 3.14159])));
|
|
|
|
test 30 0 (normalize_comparison (compare
|
|
(from_list float64 [0.0; 0.25; -4.0; 3.141592654])
|
|
(from_list float64 [0.0; 0.25; -4.0; 3.141592654])));
|
|
test 31 (-1) (normalize_comparison (compare
|
|
(from_list float64 [0.0; 0.25; -4.0])
|
|
(from_list float64 [0.0; 0.25; 3.14159])));
|
|
test 32 1 (normalize_comparison (compare
|
|
(from_list float64 [0.0; 2.718; -4.0])
|
|
(from_list float64 [0.0; 0.25; 3.14159])));
|
|
|
|
testing_function "dim";
|
|
test 1 (Array1.dim (from_list int [1;2;3;4;5])) 5;
|
|
test 2 (Array1.dim (from_list_fortran int [1;2;3])) 3;
|
|
|
|
testing_function "sub";
|
|
let a = from_list int [1;2;3;4;5;6;7;8] in
|
|
test 1 (Array1.sub a 2 5)
|
|
(from_list int [3;4;5;6;7]);
|
|
test 2 (Array1.sub a 0 2)
|
|
(from_list int [1;2]);
|
|
test 3 (Array1.sub a 0 8)
|
|
(from_list int [1;2;3;4;5;6;7;8]);
|
|
let a = from_list float64 [1.0;2.0;3.0;4.0;5.0;6.0;7.0;8.0] in
|
|
test 4 (Array1.sub a 2 5)
|
|
(from_list float64 [3.0;4.0;5.0;6.0;7.0]);
|
|
test 5 (Array1.sub a 0 2)
|
|
(from_list float64 [1.0;2.0]);
|
|
test 6 (Array1.sub a 0 8)
|
|
(from_list float64 [1.0;2.0;3.0;4.0;5.0;6.0;7.0;8.0]);
|
|
let a = from_list_fortran float64 [1.0;2.0;3.0;4.0;5.0;6.0;7.0;8.0] in
|
|
test 7 (Array1.sub a 2 5)
|
|
(from_list_fortran float64 [2.0;3.0;4.0;5.0;6.0]);
|
|
test 8 (Array1.sub a 1 2)
|
|
(from_list_fortran float64 [1.0;2.0]);
|
|
test 9 (Array1.sub a 1 8)
|
|
(from_list_fortran float64 [1.0;2.0;3.0;4.0;5.0;6.0;7.0;8.0]);
|
|
Gc.full_major(); (* test GC of proxies *)
|
|
|
|
testing_function "blit, fill";
|
|
let test_blit_fill kind data initval ofs len =
|
|
let a = from_list kind data in
|
|
let b = Array1.create kind c_layout (List.length data) in
|
|
Array1.blit a b;
|
|
(a = b) &&
|
|
(Array1.fill (Array1.sub b ofs len) initval;
|
|
let rec check i = function
|
|
[] -> true
|
|
| hd :: tl -> b.{i} = (if i >= ofs && i < ofs + len
|
|
then initval else hd)
|
|
&& check (i+1) tl
|
|
in check 0 data) in
|
|
test 1 true (test_blit_fill int8_signed [1;2;5;8;-100;127] 7 3 2);
|
|
test 2 true (test_blit_fill int8_unsigned [1;2;5;8;-100;212] 7 3 2);
|
|
test 3 true (test_blit_fill int16_signed [1;2;5;8;-100;212] 7 3 2);
|
|
test 4 true (test_blit_fill int16_unsigned [1;2;5;8;-100;212] 7 3 2);
|
|
test 5 true (test_blit_fill int [1;2;5;8;-100;212] 7 3 2);
|
|
test 6 true (test_blit_fill int32 (List.map Int32.of_int [1;2;5;8;-100;212])
|
|
(Int32.of_int 7) 3 2);
|
|
test 7 true (test_blit_fill int64 (List.map Int64.of_int [1;2;5;8;-100;212])
|
|
(Int64.of_int 7) 3 2);
|
|
test 8 true (test_blit_fill nativeint
|
|
(List.map Nativeint.of_int [1;2;5;8;-100;212])
|
|
(Nativeint.of_int 7) 3 2);
|
|
test 9 true (test_blit_fill float32 [1.0;2.0;0.5;0.125;256.0;512.0]
|
|
0.25 3 2);
|
|
test 10 true (test_blit_fill float64 [1.0;2.0;5.0;8.123;-100.456;212e19]
|
|
3.1415 3 2);
|
|
|
|
(* Bi-dimensional arrays *)
|
|
|
|
print_newline();
|
|
testing_function "------ Array2 --------";
|
|
testing_function "create/set/get";
|
|
let make_array2 kind layout ind0 dim1 dim2 fromint =
|
|
let a = Array2.create kind layout dim1 dim2 in
|
|
for i = ind0 to dim1 - 1 + ind0 do
|
|
for j = ind0 to dim2 - 1 + ind0 do
|
|
a.{i,j} <- (fromint (i * 1000 + j))
|
|
done
|
|
done;
|
|
a in
|
|
let check_array2 a ind0 dim1 dim2 fromint =
|
|
try
|
|
for i = ind0 to dim1 - 1 + ind0 do
|
|
for j = ind0 to dim2 - 1 + ind0 do
|
|
if a.{i,j} <> (fromint (i * 1000 + j)) then raise Exit
|
|
done
|
|
done;
|
|
true
|
|
with Exit -> false in
|
|
let id x = x in
|
|
test 1 true
|
|
(check_array2 (make_array2 int16_signed c_layout 0 10 20 id) 0 10 20 id);
|
|
test 2 true
|
|
(check_array2 (make_array2 int c_layout 0 10 20 id) 0 10 20 id);
|
|
test 3 true
|
|
(check_array2 (make_array2 int32 c_layout 0 10 20 Int32.of_int)
|
|
0 10 20 Int32.of_int);
|
|
test 4 true
|
|
(check_array2 (make_array2 float32 c_layout 0 10 20 float)
|
|
0 10 20 float);
|
|
test 5 true
|
|
(check_array2 (make_array2 float64 c_layout 0 10 20 float)
|
|
0 10 20 float);
|
|
test 6 true
|
|
(check_array2 (make_array2 int16_signed fortran_layout 1 10 20 id) 1 10 20 id);
|
|
test 7 true
|
|
(check_array2 (make_array2 int fortran_layout 1 10 20 id) 1 10 20 id);
|
|
test 8 true
|
|
(check_array2 (make_array2 int32 fortran_layout 1 10 20 Int32.of_int)
|
|
1 10 20 Int32.of_int);
|
|
test 9 true
|
|
(check_array2 (make_array2 float32 fortran_layout 1 10 20 float)
|
|
1 10 20 float);
|
|
test 10 true
|
|
(check_array2 (make_array2 float64 fortran_layout 1 10 20 float)
|
|
1 10 20 float);
|
|
|
|
testing_function "set/get (specialized)";
|
|
let a = Array2.create int16_signed c_layout 3 3 in
|
|
for i = 0 to 2 do for j = 0 to 2 do a.{i,j} <- i-j done done;
|
|
let ok = ref true in
|
|
for i = 0 to 2 do
|
|
for j = 0 to 2 do if a.{i,j} <> i-j then ok := false done
|
|
done;
|
|
test 1 true !ok;
|
|
test 2 true (try a.{3,0}; false with Invalid_argument _ -> true);
|
|
test 3 true (try a.{-1,0}; false with Invalid_argument _ -> true);
|
|
test 4 true (try a.{0,3}; false with Invalid_argument _ -> true);
|
|
test 5 true (try a.{0,-1}; false with Invalid_argument _ -> true);
|
|
|
|
let b = Array2.create float32 fortran_layout 3 3 in
|
|
for i = 1 to 3 do for j = 1 to 3 do b.{i,j} <- float(i-j) done done;
|
|
let ok = ref true in
|
|
for i = 1 to 3 do
|
|
for j = 1 to 3 do if b.{i,j} <> float(i-j) then ok := false done
|
|
done;
|
|
test 6 true !ok;
|
|
test 7 true (try b.{4,1}; false with Invalid_argument _ -> true);
|
|
test 8 true (try b.{0,1}; false with Invalid_argument _ -> true);
|
|
test 9 true (try b.{1,4}; false with Invalid_argument _ -> true);
|
|
test 10 true (try b.{1,0}; false with Invalid_argument _ -> true);
|
|
|
|
testing_function "dim";
|
|
let a = (make_array2 int c_layout 0 4 6 id) in
|
|
test 1 (Array2.dim1 a) 4;
|
|
test 2 (Array2.dim2 a) 6;
|
|
let b = (make_array2 int fortran_layout 1 4 6 id) in
|
|
test 3 (Array2.dim1 b) 4;
|
|
test 4 (Array2.dim2 b) 6;
|
|
|
|
testing_function "sub";
|
|
let a = make_array2 int c_layout 0 5 3 id in
|
|
let b = Array2.sub_left a 2 2 in
|
|
test 1 true
|
|
(b.{0,0} = 2000 &&
|
|
b.{0,1} = 2001 &&
|
|
b.{0,2} = 2002 &&
|
|
b.{1,0} = 3000 &&
|
|
b.{1,1} = 3001 &&
|
|
b.{1,2} = 3002);
|
|
let a = make_array2 int fortran_layout 1 5 3 id in
|
|
let b = Array2.sub_right a 2 2 in
|
|
test 2 true
|
|
(b.{1,1} = 1002 &&
|
|
b.{1,2} = 1003 &&
|
|
b.{2,1} = 2002 &&
|
|
b.{2,2} = 2003 &&
|
|
b.{3,1} = 3002 &&
|
|
b.{3,2} = 3003 &&
|
|
b.{4,1} = 4002 &&
|
|
b.{4,2} = 4003 &&
|
|
b.{5,1} = 5002 &&
|
|
b.{5,2} = 5003);
|
|
|
|
testing_function "slice";
|
|
let a = make_array2 int c_layout 0 5 3 id in
|
|
test 1 (Array2.slice_left a 0) (from_list int [0;1;2]);
|
|
test 2 (Array2.slice_left a 1) (from_list int [1000;1001;1002]);
|
|
test 3 (Array2.slice_left a 2) (from_list int [2000;2001;2002]);
|
|
test 4 (Array2.slice_left a 3) (from_list int [3000;3001;3002]);
|
|
test 5 (Array2.slice_left a 4) (from_list int [4000;4001;4002]);
|
|
let a = make_array2 int fortran_layout 1 5 3 id in
|
|
test 6 (Array2.slice_right a 1) (from_list_fortran int [1001;2001;3001;4001;5001]);
|
|
test 7 (Array2.slice_right a 2) (from_list_fortran int [1002;2002;3002;4002;5002]);
|
|
test 8 (Array2.slice_right a 3) (from_list_fortran int [1003;2003;3003;4003;5003]);
|
|
|
|
(* Tri-dimensional arrays *)
|
|
|
|
print_newline();
|
|
testing_function "------ Array3 --------";
|
|
testing_function "create/set/get";
|
|
let make_array3 kind layout ind0 dim1 dim2 dim3 fromint =
|
|
let a = Array3.create kind layout dim1 dim2 dim3 in
|
|
for i = ind0 to dim1 - 1 + ind0 do
|
|
for j = ind0 to dim2 - 1 + ind0 do
|
|
for k = ind0 to dim3 - 1 + ind0 do
|
|
a.{i, j, k} <- (fromint (i * 100 + j * 10 + k))
|
|
done
|
|
done
|
|
done;
|
|
a in
|
|
let check_array3 a ind0 dim1 dim2 dim3 fromint =
|
|
try
|
|
for i = ind0 to dim1 - 1 + ind0 do
|
|
for j = ind0 to dim2 - 1 + ind0 do
|
|
for k = ind0 to dim3 - 1 + ind0 do
|
|
if a.{i, j, k} <> (fromint (i * 100 + j * 10 + k))
|
|
then raise Exit
|
|
done
|
|
done
|
|
done;
|
|
true
|
|
with Exit -> false in
|
|
let id x = x in
|
|
test 1 true
|
|
(check_array3 (make_array3 int16_signed c_layout 0 4 5 6 id) 0 4 5 6 id);
|
|
test 2 true
|
|
(check_array3 (make_array3 int c_layout 0 4 5 6 id) 0 4 5 6 id);
|
|
test 3 true
|
|
(check_array3 (make_array3 int32 c_layout 0 4 5 6 Int32.of_int)
|
|
0 4 5 6 Int32.of_int);
|
|
test 4 true
|
|
(check_array3 (make_array3 float32 c_layout 0 4 5 6 float)
|
|
0 4 5 6 float);
|
|
test 5 true
|
|
(check_array3 (make_array3 float64 c_layout 0 4 5 6 float)
|
|
0 4 5 6 float);
|
|
test 6 true
|
|
(check_array3 (make_array3 int16_signed fortran_layout 1 4 5 6 id) 1 4 5 6 id);
|
|
test 7 true
|
|
(check_array3 (make_array3 int fortran_layout 1 4 5 6 id) 1 4 5 6 id);
|
|
test 8 true
|
|
(check_array3 (make_array3 int32 fortran_layout 1 4 5 6 Int32.of_int)
|
|
1 4 5 6 Int32.of_int);
|
|
test 9 true
|
|
(check_array3 (make_array3 float32 fortran_layout 1 4 5 6 float)
|
|
1 4 5 6 float);
|
|
test 10 true
|
|
(check_array3 (make_array3 float64 fortran_layout 1 4 5 6 float)
|
|
1 4 5 6 float);
|
|
|
|
testing_function "set/get (specialized)";
|
|
let a = Array3.create int32 c_layout 2 3 4 in
|
|
for i = 0 to 1 do for j = 0 to 2 do for k = 0 to 3 do
|
|
a.{i,j,k} <- Int32.of_int((i lsl 4) + (j lsl 2) + k)
|
|
done done done;
|
|
let ok = ref true in
|
|
for i = 0 to 1 do for j = 0 to 2 do for k = 0 to 3 do
|
|
if Int32.to_int a.{i,j,k} <> (i lsl 4) + (j lsl 2) + k then ok := false
|
|
done done done;
|
|
test 1 true !ok;
|
|
|
|
let b = Array3.create int64 fortran_layout 2 3 4 in
|
|
for i = 1 to 2 do for j = 1 to 3 do for k = 1 to 4 do
|
|
b.{i,j,k} <- Int64.of_int((i lsl 4) + (j lsl 2) + k)
|
|
done done done;
|
|
let ok = ref true in
|
|
for i = 1 to 2 do for j = 1 to 3 do for k = 1 to 4 do
|
|
if Int64.to_int b.{i,j,k} <> (i lsl 4) + (j lsl 2) + k then ok := false
|
|
done done done;
|
|
test 2 true !ok;
|
|
|
|
testing_function "dim";
|
|
let a = (make_array3 int c_layout 0 4 5 6 id) in
|
|
test 1 (Array3.dim1 a) 4;
|
|
test 2 (Array3.dim2 a) 5;
|
|
test 3 (Array3.dim3 a) 6;
|
|
let b = (make_array3 int fortran_layout 1 4 5 6 id) in
|
|
test 4 (Array3.dim1 b) 4;
|
|
test 5 (Array3.dim2 b) 5;
|
|
test 6 (Array3.dim3 b) 6;
|
|
|
|
testing_function "slice1";
|
|
let a = make_array3 int c_layout 0 3 3 3 id in
|
|
test 1 (Array3.slice_left_1 a 0 0) (from_list int [0;1;2]);
|
|
test 2 (Array3.slice_left_1 a 0 1) (from_list int [10;11;12]);
|
|
test 3 (Array3.slice_left_1 a 0 2) (from_list int [20;21;22]);
|
|
test 4 (Array3.slice_left_1 a 1 1) (from_list int [110;111;112]);
|
|
test 5 (Array3.slice_left_1 a 2 1) (from_list int [210;211;212]);
|
|
let a = make_array3 int fortran_layout 1 3 3 3 id in
|
|
test 6 (Array3.slice_right_1 a 1 2) (from_list_fortran int [112;212;312]);
|
|
test 7 (Array3.slice_right_1 a 3 1) (from_list_fortran int [131;231;331]);
|
|
|
|
(* Reshaping *)
|
|
print_newline();
|
|
testing_function "------ Reshaping --------";
|
|
testing_function "reshape_1";
|
|
let a = make_array2 int c_layout 0 3 4 id in
|
|
let b = make_array2 int fortran_layout 1 3 4 id in
|
|
let c = reshape_1 (genarray_of_array2 a) 12 in
|
|
test 1 c (from_list int [0;1;2;3;1000;1001;1002;1003;2000;2001;2002;2003]);
|
|
let d = reshape_1 (genarray_of_array2 b) 12 in
|
|
test 2 d (from_list_fortran int [1001;2001;3001;1002;2002;3002;1003;2003;3003;1004;2004;3004]);
|
|
testing_function "reshape_2";
|
|
let c = reshape_2 (genarray_of_array2 a) 4 3 in
|
|
test 1 (Array2.slice_left c 0) (from_list int [0;1;2]);
|
|
test 2 (Array2.slice_left c 1) (from_list int [3;1000;1001]);
|
|
test 3 (Array2.slice_left c 2) (from_list int [1002;1003;2000]);
|
|
test 4 (Array2.slice_left c 3) (from_list int [2001;2002;2003]);
|
|
let d = reshape_2 (genarray_of_array2 b) 4 3 in
|
|
test 5 (Array2.slice_right d 1) (from_list_fortran int [1001;2001;3001;1002]);
|
|
test 6 (Array2.slice_right d 2) (from_list_fortran int [2002;3002;1003;2003]);
|
|
test 7 (Array2.slice_right d 3) (from_list_fortran int [3003;1004;2004;3004]);
|
|
|
|
(* I/O *)
|
|
|
|
print_newline();
|
|
testing_function "------ I/O --------";
|
|
testing_function "output_value/input_value";
|
|
let test_structured_io testno value =
|
|
let tmp = Filename.temp_file "bigarray" ".data" in
|
|
let oc = open_out_bin tmp in
|
|
output_value oc value;
|
|
close_out oc;
|
|
let ic = open_in_bin tmp in
|
|
let value' = input_value ic in
|
|
close_in ic;
|
|
Sys.remove tmp;
|
|
test testno value value' in
|
|
test_structured_io 1 (from_list int8_signed [1;2;3;-4;127;-128]);
|
|
test_structured_io 2 (from_list int16_signed [1;2;3;-4;127;-128]);
|
|
test_structured_io 3 (from_list int [1;2;3;-4;127;-128]);
|
|
test_structured_io 4
|
|
(from_list int32 (List.map Int32.of_int [1;2;3;-4;127;-128]));
|
|
test_structured_io 5
|
|
(from_list int64 (List.map Int64.of_int [1;2;3;-4;127;-128]));
|
|
test_structured_io 6
|
|
(from_list nativeint (List.map Nativeint.of_int [1;2;3;-4;127;-128]));
|
|
test_structured_io 7 (from_list float32 [0.0; 0.25; -4.0; 3.141592654]);
|
|
test_structured_io 8 (from_list float64 [0.0; 0.25; -4.0; 3.141592654]);
|
|
test_structured_io 9 (make_array2 int c_layout 0 100 100 id);
|
|
test_structured_io 10 (make_array2 float64 fortran_layout 1 200 200 float);
|
|
test_structured_io 11 (make_array3 int32 c_layout 0 20 30 40 Int32.of_int);
|
|
test_structured_io 12 (make_array3 float32 fortran_layout 1 10 50 100 float);
|
|
|
|
testing_function "map_file";
|
|
let mapped_file = Filename.temp_file "bigarray" ".data" in
|
|
begin
|
|
let fd =
|
|
Unix.openfile mapped_file
|
|
[Unix.O_RDWR; Unix.O_TRUNC; Unix.O_CREAT] 0o666 in
|
|
let a = Array1.map_file fd float64 c_layout true 10000 in
|
|
Unix.close fd;
|
|
for i = 0 to 9999 do a.{i} <- float i done;
|
|
let fd = Unix.openfile mapped_file [Unix.O_RDONLY] 0 in
|
|
let b = Array2.map_file fd float64 fortran_layout false 100 (-1) in
|
|
Unix.close fd;
|
|
let ok = ref true in
|
|
for i = 0 to 99 do
|
|
for j = 0 to 99 do
|
|
if b.{j+1,i+1} <> float (100 * i + j) then ok := false
|
|
done
|
|
done;
|
|
test 1 !ok true;
|
|
b.{50,50} <- (-1.0);
|
|
let fd = Unix.openfile mapped_file [Unix.O_RDONLY] 0 in
|
|
let c = Array2.map_file fd float64 c_layout false (-1) 100 in
|
|
Unix.close fd;
|
|
let ok = ref true in
|
|
for i = 0 to 99 do
|
|
for j = 0 to 99 do
|
|
if c.{i,j} <> float (100 * i + j) then ok := false
|
|
done
|
|
done;
|
|
test 2 !ok true
|
|
end;
|
|
(* Force garbage collection of the mapped bigarrays above, otherwise
|
|
Win32 doesn't let us erase the file. Notice the begin...end above
|
|
so that the VM doesn't keep stack references to the mapped bigarrays. *)
|
|
Gc.full_major();
|
|
Sys.remove mapped_file;
|
|
|
|
()
|
|
|
|
(********* End of test *********)
|
|
|
|
let _ =
|
|
print_newline();
|
|
if !error_occurred then begin
|
|
prerr_endline "************* TEST FAILED ****************"; exit 2
|
|
end else
|
|
exit 0
|