diff options
Diffstat (limited to 'testsuite/tests')
| -rw-r--r-- | testsuite/tests/lib-bigarray-2/Makefile | 6 | ||||
| -rw-r--r-- | testsuite/tests/lib-bigarray-2/bigarrf.f | 27 | ||||
| -rw-r--r-- | testsuite/tests/lib-bigarray-2/bigarrfml.ml | 63 | ||||
| -rw-r--r-- | testsuite/tests/lib-bigarray-2/bigarrfml.reference | 27 | ||||
| -rw-r--r-- | testsuite/tests/lib-bigarray-2/bigarrfstub.c | 60 |
5 files changed, 183 insertions, 0 deletions
diff --git a/testsuite/tests/lib-bigarray-2/Makefile b/testsuite/tests/lib-bigarray-2/Makefile new file mode 100644 index 000000000..74b02913b --- /dev/null +++ b/testsuite/tests/lib-bigarray-2/Makefile @@ -0,0 +1,6 @@ +LIBRARIES=unix bigarray +C_FILES=bigarrfstub +F_FILES=bigarrf + +include ../../makefiles/Makefile.several +include ../../makefiles/Makefile.common diff --git a/testsuite/tests/lib-bigarray-2/bigarrf.f b/testsuite/tests/lib-bigarray-2/bigarrf.f new file mode 100644 index 000000000..5c2462c2e --- /dev/null +++ b/testsuite/tests/lib-bigarray-2/bigarrf.f @@ -0,0 +1,27 @@ + subroutine filltab() + + integer dimx, dimy + parameter (dimx = 8, dimy = 6) + real ftab(dimx, dimy) + common /ftab/ ftab + integer x, y + + do 100 x = 1, dimx + do 110 y = 1, dimy + ftab(x, y) = x * 100 + y + 110 continue + 100 continue + end + + subroutine printtab(tab, dimx, dimy) + + integer dimx, dimy + real tab(dimx, dimy) + integer x, y + + do 200 x = 1, dimx + print 300, x, (tab(x, y), y = 1, dimy) + 300 format(/1X, I3, 2X, 10F6.1/) + 200 continue + end + diff --git a/testsuite/tests/lib-bigarray-2/bigarrfml.ml b/testsuite/tests/lib-bigarray-2/bigarrfml.ml new file mode 100644 index 000000000..c91562284 --- /dev/null +++ b/testsuite/tests/lib-bigarray-2/bigarrfml.ml @@ -0,0 +1,63 @@ +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 C and Fortran functions *) + +external c_filltab : unit -> (float, float64_elt, c_layout) Array2.t = "c_filltab" +external c_printtab : (float, float64_elt, c_layout) Array2.t -> unit = "c_printtab" +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 C"; + c_printtab (make_array2 float64 c_layout 0 6 8 float); + testing_function "Accessing a C array"; + let a = c_filltab () in + test 1 a.{0,0} 0.0; + test 2 a.{1,0} 100.0; + test 3 a.{0,1} 1.0; + test 4 a.{5,4} 504.0; + 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; + diff --git a/testsuite/tests/lib-bigarray-2/bigarrfml.reference b/testsuite/tests/lib-bigarray-2/bigarrfml.reference new file mode 100644 index 000000000..8368d5aba --- /dev/null +++ b/testsuite/tests/lib-bigarray-2/bigarrfml.reference @@ -0,0 +1,27 @@ + + +------ Foreign function interface -------- + +Passing an array to C + +Accessing a C array + 1... 2... 3... 4... +Passing an array to Fortran + 0 0.0 1.0 2.0 3.0 4.0 5.0 6.0 7.0 + 1 1000.0 1001.0 1002.0 1003.0 1004.0 1005.0 1006.0 1007.0 + 2 2000.0 2001.0 2002.0 2003.0 2004.0 2005.0 2006.0 2007.0 + 3 3000.0 3001.0 3002.0 3003.0 3004.0 3005.0 3006.0 3007.0 + 4 4000.0 4001.0 4002.0 4003.0 4004.0 4005.0 4006.0 4007.0 + 5 5000.0 5001.0 5002.0 5003.0 5004.0 5005.0 5006.0 5007.0 + +Accessing a Fortran array + 1... 2... 3... 4... + 1 1001.01002.01003.01004.0 + + 2 2001.02002.02003.02004.0 + + 3 3001.03002.03003.03004.0 + + 4 4001.04002.04003.04004.0 + + 5 5001.05002.05003.05004.0 diff --git a/testsuite/tests/lib-bigarray-2/bigarrfstub.c b/testsuite/tests/lib-bigarray-2/bigarrfstub.c new file mode 100644 index 000000000..87bd67b7b --- /dev/null +++ b/testsuite/tests/lib-bigarray-2/bigarrfstub.c @@ -0,0 +1,60 @@ +#include <stdio.h> +#include <mlvalues.h> +#include <bigarray.h> + +extern void filltab_(void); +extern void printtab_(float * data, int * dimx, int * dimy); +extern float ftab_[]; + +#define DIMX 6 +#define DIMY 8 + +double ctab[DIMX][DIMY]; + +void filltab(void) +{ + int x, y; + for (x = 0; x < DIMX; x++) + for (y = 0; y < DIMY; y++) + ctab[x][y] = x * 100 + y; +} + +void printtab(double tab[DIMX][DIMY]) +{ + int x, y; + for (x = 0; x < DIMX; x++) { + printf("%3d", x); + for (y = 0; y < DIMY; y++) + printf(" %6.1f", tab[x][y]); + printf("\n"); + } +} + +value c_filltab(value unit) +{ + filltab(); + return alloc_bigarray_dims(BIGARRAY_FLOAT64 | BIGARRAY_C_LAYOUT, + 2, ctab, DIMX, DIMY); +} + +value c_printtab(value ba) +{ + printtab(Data_bigarray_val(ba)); + return Val_unit; +} + +value fortran_filltab(value unit) +{ + filltab_(); + return alloc_bigarray_dims(BIGARRAY_FLOAT32 | BIGARRAY_FORTRAN_LAYOUT, + 2, ftab_, 8, 6); +} + +value fortran_printtab(value ba) +{ + int dimx = Bigarray_val(ba)->dim[0]; + int dimy = Bigarray_val(ba)->dim[1]; + printtab_(Data_bigarray_val(ba), &dimx, &dimy); + return Val_unit; +} + |