summaryrefslogtreecommitdiffstats
path: root/testsuite/tests/lib-bigarray/bigarrays.ml
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests/lib-bigarray/bigarrays.ml')
-rw-r--r--testsuite/tests/lib-bigarray/bigarrays.ml775
1 files changed, 775 insertions, 0 deletions
diff --git a/testsuite/tests/lib-bigarray/bigarrays.ml b/testsuite/tests/lib-bigarray/bigarrays.ml
new file mode 100644
index 000000000..85901400e
--- /dev/null
+++ b/testsuite/tests/lib-bigarray/bigarrays.ml
@@ -0,0 +1,775 @@
+open Bigarray
+open Printf
+open Complex
+
+(* 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]);
+ test 11 true
+ (test_setget complex32
+ [Complex.zero, Complex.zero;
+ Complex.one, Complex.one;
+ Complex.i, Complex.i;
+ {im = 0.5; re = -2.0}, {im = 0.5; re = -2.0}]);
+ test 12 true
+ (test_setget complex64
+ [Complex.zero, Complex.zero;
+ Complex.one, Complex.one;
+ Complex.i, Complex.i;
+ {im=0.5;re= -2.0}, {im=0.5;re= -2.0};
+ {im=3.1415;re=1.2345678}, {im=3.1415;re=1.2345678}]);
+
+ 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 ignore a.{3}; false with Invalid_argument _ -> true);
+ test 5 true (try ignore 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 ignore b.{4}; false with Invalid_argument _ -> true);
+ test 9 true (try ignore b.{0}; false with Invalid_argument _ -> true);
+
+ let c = Array1.create complex64 c_layout 3 in
+ for i = 0 to 2 do c.{i} <- {re=float i; im=0.0} done;
+ for i = 0 to 2 do test (10 + i) c.{i} {re=float i; im=0.0} done;
+ test 13 true (try ignore c.{3}; false with Invalid_argument _ -> true);
+ test 14 true (try ignore c.{-1}; false with Invalid_argument _ -> true);
+
+ let d = Array1.create complex32 fortran_layout 3 in
+ for i = 1 to 3 do d.{i} <- {re=float i; im=0.0} done;
+ for i = 1 to 3 do test (14 + i) d.{i} {re=float i; im=0.0} done;
+ test 18 true (try ignore d.{4}; false with Invalid_argument _ -> true);
+ test 19 true (try ignore d.{0}; false with Invalid_argument _ -> true);
+
+ testing_function "set/get (unsafe, specialized)";
+ let a = Array1.create int c_layout 3 in
+ for i = 0 to 2 do Array1.unsafe_set a i i done;
+ for i = 0 to 2 do test (i+1) (Array1.unsafe_get a i) i done;
+
+ let b = Array1.create float64 fortran_layout 3 in
+ for i = 1 to 3 do Array1.unsafe_set b i (float i) done;
+ for i = 1 to 3 do test (5 + i) (Array1.unsafe_get b i) (float i) done;
+
+ 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])));
+
+ test 44 0 (normalize_comparison (compare
+ (from_list complex32 [Complex.zero; Complex.one; Complex.i])
+ (from_list complex32 [Complex.zero; Complex.one; Complex.i])));
+ test 45 (-1) (normalize_comparison (compare
+ (from_list complex32 [Complex.zero; Complex.one; Complex.i])
+ (from_list complex32 [Complex.zero; Complex.one; Complex.one])));
+ test 46 1 (normalize_comparison (compare
+ (from_list complex32 [Complex.zero; Complex.one; Complex.one])
+ (from_list complex32 [Complex.zero; Complex.one; Complex.i])));
+
+ test 47 0 (normalize_comparison (compare
+ (from_list complex64 [Complex.zero; Complex.one; Complex.i])
+ (from_list complex64 [Complex.zero; Complex.one; Complex.i])));
+ test 48 (-1) (normalize_comparison (compare
+ (from_list complex64 [Complex.zero; Complex.one; Complex.i])
+ (from_list complex64 [Complex.zero; Complex.one; Complex.one])));
+ test 49 1 (normalize_comparison (compare
+ (from_list complex64 [Complex.zero; Complex.one; Complex.one])
+ (from_list complex64 [Complex.zero; Complex.one; Complex.i])));
+
+ 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 "kind & layout";
+ let a = from_list int [1;2;3] in
+ test 1 (Array1.kind a) int;
+ test 2 (Array1.layout a) c_layout;
+ let a = from_list_fortran float32 [1.0;2.0;3.0] in
+ test 1 (Array1.kind a) float32;
+ test 2 (Array1.layout a) fortran_layout;
+
+ 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);
+ test 11 true (test_blit_fill complex32 [Complex.zero; Complex.one; Complex.i]
+ Complex.i 1 1);
+ test 12 true (test_blit_fill complex64 [Complex.zero; Complex.one; Complex.i]
+ Complex.i 1 1);
+
+(* 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);
+ let makecomplex i = {re = float i; im = float (-i)} in
+ test 11 true
+ (check_array2 (make_array2 complex32 c_layout 0 10 20 makecomplex)
+ 0 10 20 makecomplex);
+ test 12 true
+ (check_array2 (make_array2 complex64 c_layout 0 10 20 makecomplex)
+ 0 10 20 makecomplex);
+ test 13 true
+ (check_array2 (make_array2 complex32 fortran_layout 1 10 20 makecomplex)
+ 1 10 20 makecomplex);
+ test 14 true
+ (check_array2 (make_array2 complex64 fortran_layout 1 10 20 makecomplex)
+ 1 10 20 makecomplex);
+
+ 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 ignore a.{3,0}; false with Invalid_argument _ -> true);
+ test 3 true (try ignore a.{-1,0}; false with Invalid_argument _ -> true);
+ test 4 true (try ignore a.{0,3}; false with Invalid_argument _ -> true);
+ test 5 true (try ignore 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 ignore b.{4,1}; false with Invalid_argument _ -> true);
+ test 8 true (try ignore b.{0,1}; false with Invalid_argument _ -> true);
+ test 9 true (try ignore b.{1,4}; false with Invalid_argument _ -> true);
+ test 10 true (try ignore b.{1,0}; false with Invalid_argument _ -> true);
+
+ testing_function "set/get (unsafe, specialized)";
+ let a = Array2.create int16_signed c_layout 3 3 in
+ for i = 0 to 2 do for j = 0 to 2 do Array2.unsafe_set 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 Array2.unsafe_get a i j <> i-j then ok := false done
+ done;
+ test 1 true !ok;
+
+ let b = Array2.create float32 fortran_layout 3 3 in
+ for i = 1 to 3 do for j = 1 to 3 do Array2.unsafe_set 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 Array2.unsafe_get b i j <> float(i-j) then ok := false done
+ done;
+ test 2 true !ok;
+
+ 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);
+ test 11 true
+ (check_array3 (make_array3 complex32 c_layout 0 4 5 6 makecomplex)
+ 0 4 5 6 makecomplex);
+ test 12 true
+ (check_array3 (make_array3 complex64 c_layout 0 4 5 6 makecomplex)
+ 0 4 5 6 makecomplex);
+ test 13 true
+ (check_array3 (make_array3 complex32 fortran_layout 1 4 5 6 makecomplex)
+ 1 4 5 6 makecomplex);
+ test 14 true
+ (check_array3 (make_array3 complex64 fortran_layout 1 4 5 6 makecomplex)
+ 1 4 5 6 makecomplex);
+
+
+ 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 "set/get (unsafe, 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
+ Array3.unsafe_set 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 (Array3.unsafe_get a i j k) <> (i lsl 4) + (j lsl 2) + k then ok := false
+ done done done;
+ test 1 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);
+ test_structured_io 13 (make_array2 complex32 c_layout 0 100 100 makecomplex);
+ test_structured_io 14 (make_array3 complex64 fortran_layout 1 10 20 30 makecomplex);
+
+ 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;
+ let fd = Unix.openfile mapped_file [Unix.O_RDONLY] 0 in
+ let c = Array2.map_file fd ~pos:800L float64 c_layout false (-1) 100 in
+ Unix.close fd;
+ let ok = ref true in
+ for i = 1 to 99 do
+ for j = 0 to 99 do
+ if c.{i-1,j} <> float (100 * i + j) then ok := false
+ done
+ done;
+ test 3 !ok true;
+ let fd = Unix.openfile mapped_file [Unix.O_RDONLY] 0 in
+ let c = Array2.map_file fd ~pos:79200L float64 c_layout false (-1) 100 in
+ Unix.close fd;
+ let ok = ref true in
+ for j = 0 to 99 do
+ if c.{0,j} <> float (100 * 99 + j) then ok := false
+ done;
+ test 4 !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
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-20 00:19:27 +0000