Test bigarrays interface externe

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@2879 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

4 files changed, 130 insertions, 4 deletions

diff --git a/test/Moretest/Makefile b/test/Moretest/Makefile
index 3fb7baef17..528ff87327 100644
--- a/test/Moretest/Makefile
+++ b/test/Moretest/Makefile
@@ -45,23 +45,35 @@ cm.out: cmcaml.ml cmstub.c cmmain.c
 	$(CAMLOPT) -output-obj -o cm.o cmcaml.ml
 	$(NATIVECC) -g -o cm.out cm.o -I$(LIBDIR) -DNO_BYTECODE_FILE cmstub.c cmmain.c ../../asmrun/libasmrun.a $(CCLIBS)
 
-bigarrays.byt: ../../otherlibs/bigarray/bigarray.cma \
+bigarrays.byt: bigarrf.o bigarrfstub.o \
+               ../../otherlibs/bigarray/bigarray.cma \
                ../../otherlibs/bigarray/libbigarray.a bigarrays.ml
 	$(CAMLC) -custom -o bigarrays.byt \
                 -I ../../otherlibs/bigarray \
                 -I ../../otherlibs/unix \
                 unix.cma bigarray.cma bigarrays.ml \
+                bigarrf.o bigarrfstub.o \
                 ../../otherlibs/bigarray/libbigarray.a \
-                ../../otherlibs/unix/libunix.a
+                ../../otherlibs/unix/libunix.a \
+                ../../byterun/libcamlrun.a -cclib -lg2c
 
-bigarrays.out: ../../otherlibs/bigarray/bigarray.cmxa \
+bigarrays.out: bigarrf.o bigarrfstub.o \
+               ../../otherlibs/bigarray/bigarray.cmxa \
                ../../otherlibs/bigarray/libbigarray.a bigarrays.ml
 	$(CAMLOPT) $(OPTFLAGS) -o bigarrays.out \
                 -I ../../otherlibs/bigarray \
                 -I ../../otherlibs/unix \
                 unix.cmxa bigarray.cmxa bigarrays.ml \
+                bigarrf.o bigarrfstub.o \
                 ../../otherlibs/bigarray/libbigarray.a \
-                ../../otherlibs/unix/libunix.a
+                ../../otherlibs/unix/libunix.a \
+                ../../asmrun/libasmrun.a -cclib -lg2c
+
+bigarrf.o: bigarrf.f
+	g77 -c bigarrf.f
+
+bigarrfstub.o: bigarrfstub.c
+	$(NATIVECC) $(NATIVECCCOMPOPTS) -I../../byterun -I../../otherlibs/bigarray -c bigarrfstub.c
 
 # Common rules
 
diff --git a/test/Moretest/bigarrays.ml b/test/Moretest/bigarrays.ml
index cd73c31cab..702dcb95e9 100644
--- a/test/Moretest/bigarrays.ml
+++ b/test/Moretest/bigarrays.ml
@@ -24,6 +24,13 @@ let test test_number answer correct_answer =
    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"
+
 (* One-dimensional arrays *)
 
 let _ =
@@ -594,6 +601,27 @@ let _ =
   test 2 !ok true;
   Sys.remove mapped_file;
 
+(* I/O *)
+
+  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;
+
   ()
                   
 (********* End of test *********)
diff --git a/test/Moretest/bigarrf.f b/test/Moretest/bigarrf.f
new file mode 100644
index 0000000000..734863a016
--- /dev/null
+++ b/test/Moretest/bigarrf.f
@@ -0,0 +1,26 @@
+	subroutine filltab()
+
+	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/test/Moretest/bigarrfstub.c b/test/Moretest/bigarrfstub.c
new file mode 100644
index 0000000000..87bd67b7bc
--- /dev/null
+++ b/test/Moretest/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;
+}
+