diff options
Diffstat (limited to 'testsuite/tests')
-rw-r--r-- | testsuite/tests/c-api/alloc_async.ml | 17 | ||||
-rw-r--r-- | testsuite/tests/c-api/alloc_async.reference | 5 | ||||
-rw-r--r-- | testsuite/tests/c-api/alloc_async_stubs.c | 54 | ||||
-rw-r--r-- | testsuite/tests/c-api/ocamltests | 1 |
4 files changed, 77 insertions, 0 deletions
diff --git a/testsuite/tests/c-api/alloc_async.ml b/testsuite/tests/c-api/alloc_async.ml new file mode 100644 index 0000000000..0ed35acf16 --- /dev/null +++ b/testsuite/tests/c-api/alloc_async.ml @@ -0,0 +1,17 @@ +(* TEST + modules = "alloc_async_stubs.c" +*) + +external test : int ref -> unit = "stub" + +let f () = + let r = ref 42 in + Gc.finalise (fun s -> r := !s) (ref 17); + Printf.printf "OCaml, before: %d\n%!" !r; + test r; + Printf.printf "OCaml, after: %d\n%!" !r; + ignore (Sys.opaque_identity (ref 100)); + Printf.printf "OCaml, after alloc: %d\n%!" !r; + () + +let () = (f [@inlined never]) () diff --git a/testsuite/tests/c-api/alloc_async.reference b/testsuite/tests/c-api/alloc_async.reference new file mode 100644 index 0000000000..839271f55d --- /dev/null +++ b/testsuite/tests/c-api/alloc_async.reference @@ -0,0 +1,5 @@ +OCaml, before: 42 +C, before: 42 +C, after: 42 +OCaml, after: 42 +OCaml, after alloc: 17 diff --git a/testsuite/tests/c-api/alloc_async_stubs.c b/testsuite/tests/c-api/alloc_async_stubs.c new file mode 100644 index 0000000000..5734b06de4 --- /dev/null +++ b/testsuite/tests/c-api/alloc_async_stubs.c @@ -0,0 +1,54 @@ +#include <stdio.h> +#include <stdlib.h> +#include "caml/alloc.h" +#include "caml/memory.h" + +const char* strs[] = { "foo", "bar", 0 }; +value stub(value ref) +{ + CAMLparam1(ref); + CAMLlocal2(x, y); + int i; char* s; intnat coll_before; + + printf("C, before: %d\n", Int_val(Field(ref, 0))); + + /* First, do enough major allocation to trigger a major collection */ + coll_before = Caml_state_field(stat_major_collections); + while (Caml_state_field(stat_major_collections) == coll_before) { + caml_alloc(10000, 0); + } + + /* Now, call lots of allocation functions */ + + /* Small allocations */ + caml_alloc(10, 0); + x = caml_alloc_small(2, 0); + Field(x, 0) = Val_unit; + Field(x, 1) = Val_unit; + caml_alloc_tuple(3); + caml_alloc_float_array(10); + caml_alloc_string(42); + caml_alloc_initialized_string(10, "abcdeabcde"); + caml_copy_string("asoidjfa"); + caml_copy_string_array(strs); + caml_copy_double(42.0); + caml_copy_int32(100); + caml_copy_int64(100); + caml_alloc_array(caml_copy_string, strs); + caml_alloc_sprintf("[%d]", 42); + + /* Large allocations */ + caml_alloc(1000, 0); + caml_alloc_shr(1000, 0); + caml_alloc_tuple(1000); + caml_alloc_float_array(1000); + caml_alloc_string(10000); + s = calloc(10000, 1); + caml_alloc_initialized_string(10000, s); + free(s); + + + printf("C, after: %d\n", Int_val(Field(ref, 0))); + fflush(stdout); + CAMLreturn (Val_unit); +} diff --git a/testsuite/tests/c-api/ocamltests b/testsuite/tests/c-api/ocamltests new file mode 100644 index 0000000000..2741b81d4e --- /dev/null +++ b/testsuite/tests/c-api/ocamltests @@ -0,0 +1 @@ +alloc_async.ml |