1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
(* TEST
readonly_files = "bigarrf.f bigarrfstub.c";
last_flags = "-cclib -lgfortran";
script = "sh ${test_source_directory}/has-gfortran.sh";
script;
{
setup-ocamlc.byte-build-env;
script = "sh ${test_source_directory}/call-gfortran.sh ${cc} -c bigarrf.f";
script;
all_modules = "bigarrf.o bigarrfstub.c bigarrfml.ml";
ocamlc.byte;
output = "${test_build_directory}/program-output";
stdout = "${output}";
run;
check-program-output;
}{
setup-ocamlopt.byte-build-env;
script = "sh ${test_source_directory}/call-gfortran.sh ${cc} -c bigarrf.f";
script;
all_modules = "bigarrf.o bigarrfstub.c bigarrfml.ml";
ocamlopt.byte;
output = "${test_build_directory}/program-output";
stdout = "${output}";
run;
check-program-output;
}
*)
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
(* External Fortran functions *)
external fortran_filltab :
unit -> (float, float32_elt, fortran_layout) Array2.t = "fortran_filltab"
external fortran_printtab :
(float, float32_elt, fortran_layout) Array2.t -> unit = "fortran_printtab"
let _ =
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
print_newline();
testing_function "------ Foreign function interface --------";
testing_function "Passing an array to Fortran";
fortran_printtab (make_array2 float32 fortran_layout 1 5 4 float);
testing_function "Accessing a Fortran array";
let a = fortran_filltab () in
test 1 a.{1,1} 101.0;
test 2 a.{2,1} 201.0;
test 3 a.{1,2} 102.0;
test 4 a.{5,4} 504.0;
|
