Merge pull request #430 from yallop/lwt-preemptive

Add support for Lwt_preemptive

Makefile.tests

@@ -877,44 +877,125 @@ $(BUILDDIR)/test-lwt-jobs-ml-stub-generator.$(BEST): $(BUILDDIR)/tests/test-lwt-
 $(BUILDDIR)/tests/test-lwt-jobs/generated_struct_stubs.c: $(BUILDDIR)/test-lwt-jobs-stub-generator.$(BEST)
 	$< --c-struct-file $@
 
-test-returning-errno-lwt-stubs.dir  = tests/test-returning-errno-lwt/stubs
-test-returning-errno-lwt-stubs.threads = yes
-test-returning-errno-lwt-stubs.subproject_deps = ctypes cstubs \
+test-lwt-preemptive-stubs.dir  = tests/test-lwt-preemptive/stubs
+test-lwt-preemptive-stubs.threads = yes
+test-lwt-preemptive-stubs.subproject_deps = ctypes cstubs \
    ctypes-foreign-base ctypes-foreign-threaded tests-common
-test-returning-errno-lwt-stubs: PROJECT=test-returning-errno-lwt-stubs
-test-returning-errno-lwt-stubs: $$(LIB_TARGETS)
-
-test-returning-errno-lwt-stub-generator.dir = tests/test-returning-errno-lwt/stub-generator
-test-returning-errno-lwt-stub-generator.threads = yes
-test-returning-errno-lwt-stub-generator.subproject_deps = ctypes cstubs \
-     ctypes-foreign-base ctypes-foreign-threaded test-returning-errno-lwt-stubs tests-common
-test-returning-errno-lwt-stub-generator.deps = str bigarray bytes
-test-returning-errno-lwt-stub-generator: PROJECT=test-returning-errno-lwt-stub-generator
-test-returning-errno-lwt-stub-generator: $$(BEST_TARGET)
-
-test-returning-errno-lwt.dir = tests/test-returning-errno-lwt
-test-returning-errno-lwt.threads = yes
-test-returning-errno-lwt.deps = str bigarray oUnit bytes lwt.unix
-test-returning-errno-lwt.subproject_deps = ctypes ctypes-foreign-base \
-   ctypes-foreign-threaded cstubs tests-common test-returning-errno-lwt-stubs
-test-returning-errno-lwt.link_flags = -L$(BUILDDIR)/clib -ltest_functions
-test-returning-errno-lwt: PROJECT=test-returning-errno-lwt
-test-returning-errno-lwt: $$(BEST_TARGET)
-
-test-returning-errno-lwt-generated: \
-  tests/test-returning-errno-lwt/generated_bindings.ml \
-  tests/test-returning-errno-lwt/generated_struct_bindings.ml \
-  tests/test-returning-errno-lwt/generated_stubs.c
-
-tests/test-returning-errno-lwt/generated_stubs.c: $(BUILDDIR)/test-returning-errno-lwt-stub-generator.$(BEST)
+test-lwt-preemptive-stubs: PROJECT=test-lwt-preemptive-stubs
+test-lwt-preemptive-stubs: $$(LIB_TARGETS)
+
+test-lwt-preemptive-stub-generator.dir = tests/test-lwt-preemptive/stub-generator
+test-lwt-preemptive-stub-generator.threads = yes
+test-lwt-preemptive-stub-generator.subproject_deps = ctypes cstubs \
+     ctypes-foreign-base ctypes-foreign-threaded test-lwt-preemptive-stubs tests-common
+test-lwt-preemptive-stub-generator.deps = str bigarray bytes
+test-lwt-preemptive-stub-generator: PROJECT=test-lwt-preemptive-stub-generator
+test-lwt-preemptive-stub-generator: $$(BEST_TARGET)
+
+test-lwt-preemptive.dir = tests/test-lwt-preemptive
+test-lwt-preemptive.threads = yes
+test-lwt-preemptive.deps = str bigarray oUnit bytes lwt.preemptive
+test-lwt-preemptive.subproject_deps = ctypes ctypes-foreign-base \
+   ctypes-foreign-threaded cstubs tests-common test-lwt-preemptive-stubs
+test-lwt-preemptive.link_flags = -L$(BUILDDIR)/clib -ltest_functions
+test-lwt-preemptive: PROJECT=test-lwt-preemptive
+test-lwt-preemptive: $$(BEST_TARGET)
+
+test-lwt-preemptive-generated: \
+  tests/test-lwt-preemptive/generated_bindings.ml \
+  tests/test-lwt-preemptive/generated_stubs.c \
+  tests/test-lwt-preemptive/generated_struct_bindings.ml \
+  $(BUILDDIR)/tests/test-lwt-preemptive/generated_struct_stubs.c
+
+tests/test-lwt-preemptive/generated_stubs.c: $(BUILDDIR)/test-lwt-preemptive-stub-generator.$(BEST)
 	$< --c-file $@
-tests/test-returning-errno-lwt/generated_bindings.ml: $(BUILDDIR)/test-returning-errno-lwt-stub-generator.$(BEST)
+tests/test-lwt-preemptive/generated_bindings.ml: $(BUILDDIR)/test-lwt-preemptive-stub-generator.$(BEST)
 	$< --ml-file $@
-tests/test-returning-errno-lwt/generated_struct_bindings.ml: $(BUILDDIR)/test-returning-errno-lwt-ml-stub-generator.$(BEST)
+tests/test-lwt-preemptive/generated_struct_bindings.ml: $(BUILDDIR)/test-lwt-preemptive-ml-stub-generator.$(BEST)
 	$< > $@
-$(BUILDDIR)/test-returning-errno-lwt-ml-stub-generator.$(BEST): $(BUILDDIR)/tests/test-returning-errno-lwt/generated_struct_stubs.c
+$(BUILDDIR)/test-lwt-preemptive-ml-stub-generator.$(BEST): $(BUILDDIR)/tests/test-lwt-preemptive/generated_struct_stubs.c
 	$(CC) -I `$(OCAMLFIND) ocamlc -where | sed 's|\r$$||'` $(CFLAGS) $(LDFLAGS) $(WINLDFLAGS) -o $@ $^
-$(BUILDDIR)/tests/test-returning-errno-lwt/generated_struct_stubs.c: $(BUILDDIR)/test-returning-errno-lwt-stub-generator.$(BEST)
+$(BUILDDIR)/tests/test-lwt-preemptive/generated_struct_stubs.c: $(BUILDDIR)/test-lwt-preemptive-stub-generator.$(BEST)
+	$< --c-struct-file $@
+
+test-returning-errno-lwt-jobs-stubs.dir  = tests/test-returning-errno-lwt-jobs/stubs
+test-returning-errno-lwt-jobs-stubs.threads = yes
+test-returning-errno-lwt-jobs-stubs.subproject_deps = ctypes cstubs \
+   ctypes-foreign-base ctypes-foreign-threaded tests-common
+test-returning-errno-lwt-jobs-stubs: PROJECT=test-returning-errno-lwt-jobs-stubs
+test-returning-errno-lwt-jobs-stubs: $$(LIB_TARGETS)
+
+test-returning-errno-lwt-jobs-stub-generator.dir = tests/test-returning-errno-lwt-jobs/stub-generator
+test-returning-errno-lwt-jobs-stub-generator.threads = yes
+test-returning-errno-lwt-jobs-stub-generator.subproject_deps = ctypes cstubs \
+     ctypes-foreign-base ctypes-foreign-threaded test-returning-errno-lwt-jobs-stubs tests-common
+test-returning-errno-lwt-jobs-stub-generator.deps = str bigarray bytes
+test-returning-errno-lwt-jobs-stub-generator: PROJECT=test-returning-errno-lwt-jobs-stub-generator
+test-returning-errno-lwt-jobs-stub-generator: $$(BEST_TARGET)
+
+test-returning-errno-lwt-jobs.dir = tests/test-returning-errno-lwt-jobs
+test-returning-errno-lwt-jobs.threads = yes
+test-returning-errno-lwt-jobs.deps = str bigarray oUnit bytes lwt.unix
+test-returning-errno-lwt-jobs.subproject_deps = ctypes ctypes-foreign-base \
+   ctypes-foreign-threaded cstubs tests-common test-returning-errno-lwt-jobs-stubs
+test-returning-errno-lwt-jobs.link_flags = -L$(BUILDDIR)/clib -ltest_functions
+test-returning-errno-lwt-jobs: PROJECT=test-returning-errno-lwt-jobs
+test-returning-errno-lwt-jobs: $$(BEST_TARGET)
+
+test-returning-errno-lwt-jobs-generated: \
+  tests/test-returning-errno-lwt-jobs/generated_bindings.ml \
+  tests/test-returning-errno-lwt-jobs/generated_struct_bindings.ml \
+  tests/test-returning-errno-lwt-jobs/generated_stubs.c
+
+tests/test-returning-errno-lwt-jobs/generated_stubs.c: $(BUILDDIR)/test-returning-errno-lwt-jobs-stub-generator.$(BEST)
+	$< --c-file $@
+tests/test-returning-errno-lwt-jobs/generated_bindings.ml: $(BUILDDIR)/test-returning-errno-lwt-jobs-stub-generator.$(BEST)
+	$< --ml-file $@
+tests/test-returning-errno-lwt-jobs/generated_struct_bindings.ml: $(BUILDDIR)/test-returning-errno-lwt-jobs-ml-stub-generator.$(BEST)
+	$< > $@
+$(BUILDDIR)/test-returning-errno-lwt-jobs-ml-stub-generator.$(BEST): $(BUILDDIR)/tests/test-returning-errno-lwt-jobs/generated_struct_stubs.c
+	$(CC) -I `$(OCAMLFIND) ocamlc -where | sed 's|\r$$||'` $(CFLAGS) $(LDFLAGS) $(WINLDFLAGS) -o $@ $^
+$(BUILDDIR)/tests/test-returning-errno-lwt-jobs/generated_struct_stubs.c: $(BUILDDIR)/test-returning-errno-lwt-jobs-stub-generator.$(BEST)
+	$< --c-struct-file $@
+
+test-returning-errno-lwt-preemptive-stubs.dir  = tests/test-returning-errno-lwt-preemptive/stubs
+test-returning-errno-lwt-preemptive-stubs.threads = yes
+test-returning-errno-lwt-preemptive-stubs.subproject_deps = ctypes cstubs \
+   ctypes-foreign-base ctypes-foreign-threaded tests-common
+test-returning-errno-lwt-preemptive-stubs: PROJECT=test-returning-errno-lwt-preemptive-stubs
+test-returning-errno-lwt-preemptive-stubs: $$(LIB_TARGETS)
+
+test-returning-errno-lwt-preemptive-stub-generator.dir = tests/test-returning-errno-lwt-preemptive/stub-generator
+test-returning-errno-lwt-preemptive-stub-generator.threads = yes
+test-returning-errno-lwt-preemptive-stub-generator.subproject_deps = ctypes cstubs \
+     ctypes-foreign-base ctypes-foreign-threaded test-returning-errno-lwt-preemptive-stubs tests-common
+test-returning-errno-lwt-preemptive-stub-generator.deps = str bigarray bytes
+test-returning-errno-lwt-preemptive-stub-generator: PROJECT=test-returning-errno-lwt-preemptive-stub-generator
+test-returning-errno-lwt-preemptive-stub-generator: $$(BEST_TARGET)
+
+test-returning-errno-lwt-preemptive.dir = tests/test-returning-errno-lwt-preemptive
+test-returning-errno-lwt-preemptive.threads = yes
+test-returning-errno-lwt-preemptive.deps = str bigarray oUnit bytes lwt.preemptive
+test-returning-errno-lwt-preemptive.subproject_deps = ctypes ctypes-foreign-base \
+   ctypes-foreign-threaded cstubs tests-common test-returning-errno-lwt-preemptive-stubs
+test-returning-errno-lwt-preemptive.link_flags = -L$(BUILDDIR)/clib -ltest_functions
+test-returning-errno-lwt-preemptive: PROJECT=test-returning-errno-lwt-preemptive
+test-returning-errno-lwt-preemptive: $$(BEST_TARGET)
+
+test-returning-errno-lwt-preemptive-generated: \
+  tests/test-returning-errno-lwt-preemptive/generated_bindings.ml \
+  tests/test-returning-errno-lwt-preemptive/generated_struct_bindings.ml \
+  tests/test-returning-errno-lwt-preemptive/generated_stubs.c
+
+tests/test-returning-errno-lwt-preemptive/generated_stubs.c: $(BUILDDIR)/test-returning-errno-lwt-preemptive-stub-generator.$(BEST)
+	$< --c-file $@
+tests/test-returning-errno-lwt-preemptive/generated_bindings.ml: $(BUILDDIR)/test-returning-errno-lwt-preemptive-stub-generator.$(BEST)
+	$< --ml-file $@
+tests/test-returning-errno-lwt-preemptive/generated_struct_bindings.ml: $(BUILDDIR)/test-returning-errno-lwt-preemptive-ml-stub-generator.$(BEST)
+	$< > $@
+$(BUILDDIR)/test-returning-errno-lwt-preemptive-ml-stub-generator.$(BEST): $(BUILDDIR)/tests/test-returning-errno-lwt-preemptive/generated_struct_stubs.c
+	$(CC) -I `$(OCAMLFIND) ocamlc -where | sed 's|\r$$||'` $(CFLAGS) $(LDFLAGS) $(WINLDFLAGS) -o $@ $^
+$(BUILDDIR)/tests/test-returning-errno-lwt-preemptive/generated_struct_stubs.c: $(BUILDDIR)/test-returning-errno-lwt-preemptive-stub-generator.$(BEST)
 	$< --c-struct-file $@
 
 test-returning-errno-stubs.dir  = tests/test-returning-errno/stubs
@@ -934,7 +1015,7 @@ test-returning-errno-stub-generator: $$(BEST_TARGET)
 
 test-returning-errno.dir = tests/test-returning-errno
 test-returning-errno.threads = yes
-test-returning-errno.deps = str bigarray oUnit bytes lwt.unix
+test-returning-errno.deps = str bigarray oUnit bytes
 test-returning-errno.subproject_deps = ctypes ctypes-foreign-base \
    ctypes-foreign-threaded cstubs tests-common test-returning-errno-stubs
 test-returning-errno.link_flags = -L$(BUILDDIR)/clib -ltest_functions
@@ -1024,7 +1105,9 @@ TESTS += test-coercions-stubs test-coercions-stub-generator test-coercions-gener
 TESTS += test-roots
 TESTS += test-passing-ocaml-values-stubs test-passing-ocaml-values-stub-generator test-passing-ocaml-values-generated test-passing-ocaml-values
 TESTS += test-lwt-jobs-stubs test-lwt-jobs-stub-generator test-lwt-jobs-generated test-lwt-jobs
-TESTS += test-returning-errno-lwt-stubs test-returning-errno-lwt-stub-generator test-returning-errno-lwt-generated test-returning-errno-lwt
+TESTS += test-lwt-preemptive-stubs test-lwt-preemptive-stub-generator test-lwt-preemptive-generated test-lwt-preemptive
+TESTS += test-returning-errno-lwt-jobs-stubs test-returning-errno-lwt-jobs-stub-generator test-returning-errno-lwt-jobs-generated test-returning-errno-lwt-jobs
+TESTS += test-returning-errno-lwt-preemptive-stubs test-returning-errno-lwt-preemptive-stub-generator test-returning-errno-lwt-preemptive-generated test-returning-errno-lwt-preemptive
 TESTS += test-returning-errno-stubs test-returning-errno-stub-generator test-returning-errno-generated test-returning-errno
 TESTS += test-threads-stubs test-threads-stub-generator test-threads-generated test-threads
 

src/cstubs/cstubs.ml

@@ -23,7 +23,7 @@ module type FOREIGN' = FOREIGN with type 'a result = unit
 
 module type BINDINGS = functor (F : FOREIGN') -> sig end
 
-type concurrency_policy = [ `Sequential | `Lwt_jobs | `Unlocked ]
+type concurrency_policy = [ `Sequential | `Lwt_jobs | `Lwt_preemptive | `Unlocked ]
 
 type errno_policy = [ `Ignore_errno | `Return_errno ]
 
@@ -54,12 +54,12 @@ let write_return :
   fun ~concurrency ~errno fmt -> match concurrency, errno with
       (`Sequential|`Unlocked), `Ignore_errno -> Format.fprintf fmt "type 'a return = 'a@\n"
     | (`Sequential|`Unlocked), `Return_errno -> Format.fprintf fmt "type 'a return = 'a * Signed.sint@\n"
-    | `Lwt_jobs, `Ignore_errno ->
+    | (`Lwt_jobs|`Lwt_preemptive), `Ignore_errno ->
       begin
         Format.fprintf fmt "type 'a return = { lwt: 'a Lwt.t }@\n";
         Format.fprintf fmt "let box_lwt lwt = {lwt}@\n";
       end
-    | `Lwt_jobs, `Return_errno ->
+    | (`Lwt_jobs|`Lwt_preemptive), `Return_errno ->
       begin
         Format.fprintf fmt "type 'a return = { lwt: ('a * Signed.sint) Lwt.t }@\n";
         Format.fprintf fmt "let box_lwt lwt = {lwt}@\n";
@@ -78,9 +78,9 @@ let write_map_result ~concurrency ~errno fmt =
     Format.fprintf fmt "let map_result f x = f x@\n"
   | (`Sequential|`Unlocked), `Return_errno ->
     Format.fprintf fmt "let map_result f (x, y) = (f x, y)@\n"
-  | `Lwt_jobs, `Ignore_errno ->
+  | (`Lwt_jobs|`Lwt_preemptive), `Ignore_errno ->
     Format.fprintf fmt "let map_result f x = Lwt.map f x@\n"
-  | `Lwt_jobs, `Return_errno ->
+  | (`Lwt_jobs|`Lwt_preemptive), `Return_errno ->
     Format.fprintf fmt "let map_result f v = Lwt.map (fun (x, y) -> (f x, y)) v@\n"
 
 let write_foreign ~concurrency ~errno fmt bindings val_bindings =
@@ -149,13 +149,14 @@ let gen_ml ~concurrency ~errno prefix fmt : (module FOREIGN') * (unit -> unit) =
 
 let sequential = `Sequential
 let lwt_jobs = `Lwt_jobs
+let lwt_preemptive = `Lwt_preemptive
 let ignore_errno = `Ignore_errno
 let return_errno = `Return_errno
 let unlocked = `Unlocked
 
 let concurrency_headers = function
     `Sequential -> []
-  | `Lwt_jobs ->   ["\"lwt_unix.h\"";  "<caml/memory.h>"]
+  | `Lwt_jobs | `Lwt_preemptive ->   ["\"lwt_unix.h\"";  "<caml/memory.h>"]
   | `Unlocked -> ["<caml/threads.h>"]
 
 let errno_headers = function

src/cstubs/cstubs.mli

@@ -130,6 +130,29 @@ val unlocked : concurrency_policy
 (** Generate code that releases the runtime lock during C calls.
 *)
 
+val lwt_preemptive : concurrency_policy
+(** Generate code which runs C function calls with the Lwt_preemptive module:
+
+    http://ocsigen.org/lwt/2.5.1/api/Lwt_preemptive
+
+    Passing [lwt_preemptive] as the [concurrency] argument to {!Cstubs.write_c} and
+    {!Cstubs.write_ml} changes the return type of bound functions to include
+    the {!Lwt.t} constructor.  For example, the binding specification
+
+       [let unlink = foreign "unlink" (string @-> returning int)]
+
+    generates a value of the following type by default:
+
+       [val unlink : string -> int]
+
+    but when using [lwt_preemptive] the generated type is as follows:
+
+       [val unlink : string -> int Lwt.t]
+
+    Additionally, the OCaml runtime lock is released during calls to functions
+    bound with [lwt_preemptive].
+*)
+
 val lwt_jobs : concurrency_policy
 (** Generate code which implements C function calls as Lwt jobs:
 

src/cstubs/cstubs_generate_c.ml

@@ -529,6 +529,7 @@ struct
 end
 
 let fn ~concurrency ~errno = match concurrency with
-    `Sequential | `Unlocked as c -> fn ~concurrency:c ~errno
+  | `Lwt_preemptive | `Unlocked -> fn ~concurrency:`Unlocked ~errno
+  | `Sequential -> fn ~concurrency:`Sequential ~errno
   | `Lwt_jobs -> Lwt.fn ~errno
 

src/cstubs/cstubs_generate_c.mli

@@ -7,7 +7,7 @@
 
 (* C stub generation *)
 
-val fn : concurrency:[ `Sequential | `Lwt_jobs | `Unlocked ] ->
+val fn : concurrency:[ `Sequential | `Lwt_jobs | `Lwt_preemptive | `Unlocked ] ->
          errno:[ `Ignore_errno | `Return_errno ] ->
          cname:string -> stub_name:string ->
          Format.formatter -> 'a Ctypes.fn -> unit

src/cstubs/cstubs_generate_ml.ml

@@ -12,7 +12,8 @@ open Ctypes_path
 open Cstubs_errors
 
 type non_lwt = [ `Sequential | `Unlocked ]
-type concurrency_policy = [ non_lwt | `Lwt_jobs ]
+type lwt = [ `Lwt_jobs | `Lwt_preemptive ]
+type concurrency_policy = [ non_lwt | lwt ]
 type errno_policy = [ `Ignore_errno | `Return_errno ]
 
 type lident = string
@@ -290,9 +291,9 @@ let rec ml_external_type_of_fn :
   type a. concurrency:concurrency_policy -> errno:errno_policy ->
   a fn -> polarity -> ml_external_type =
   fun ~concurrency ~errno fn polarity -> match fn, concurrency, errno with
-    | Returns t, #non_lwt, `Ignore_errno ->
+    | Returns t, (#non_lwt|`Lwt_preemptive), `Ignore_errno ->
       `Prim ([], ml_typ_of_typ polarity t)
-    | Returns t, #non_lwt, `Return_errno ->
+    | Returns t, (#non_lwt|`Lwt_preemptive), `Return_errno ->
       `Prim ([], `Pair (ml_typ_of_typ polarity t, int_type))
     | Returns t, `Lwt_jobs, `Ignore_errno ->
       `Prim ([], `Appl (lwt_job_type, [ml_typ_of_typ polarity t]))
@@ -483,10 +484,15 @@ type wrapper_state = {
 }
 
 let lwt_unix_run_job = Ctypes_path.path_of_string "Lwt_unix.run_job"
+let lwt_preemptive_detach = Ctypes_path.path_of_string "Lwt_preemptive.detach"
 
 let run_exp ~concurrency exp = match concurrency with
     #non_lwt -> exp
   | `Lwt_jobs -> `Appl (`Ident lwt_unix_run_job, exp)
+  | `Lwt_preemptive -> `Appl
+                         (`Appl (`Ident lwt_preemptive_detach,
+                                 `Fun (["_"], exp)),
+                          `Unit)
 
 let let_bind : (lident * ml_exp) list -> ml_exp -> ml_exp =
   fun binds e ->
@@ -548,15 +554,15 @@ let wrapper : type a. concurrency:concurrency_policy -> errno:errno_policy ->
       (pat, let_bind binds (run_exp ~concurrency (`Ident id)))
     | { exp; args; pat; binds }, #non_lwt ->
       (pat, `Fun (args, let_bind binds exp))
-    | { trivial = true; pat; args; binds }, `Lwt_jobs ->
+    | { trivial = true; pat; args; binds }, #lwt ->
       let exp : ml_exp = List.fold_left (fun f p -> `Appl (f, `Ident (path_of_string p))) (`Ident id) args in
       (pat, `Fun (args,
                   let_bind binds
                     (`Appl (`Ident box_lwt,
                             `Appl (`Appl (`Ident lwt_bind,
                                           run_exp ~concurrency exp),
                                    return_result ~args:(args @ (List.map fst binds)))))))
-    | { exp; args; pat; binds }, `Lwt_jobs ->
+    | { exp; args; pat; binds }, #lwt ->
       (pat, `Fun (args,
                   let_bind binds
                     (`Appl (`Ident box_lwt,

src/cstubs/cstubs_generate_ml.mli

@@ -7,20 +7,20 @@
 
 (* ML stub generation *)
 
-val extern : concurrency:[ `Sequential | `Lwt_jobs | `Unlocked ] ->
+val extern : concurrency:[ `Sequential | `Lwt_jobs | `Lwt_preemptive | `Unlocked ] ->
          errno:[ `Ignore_errno | `Return_errno ] ->
          stub_name:string -> external_name:string -> Format.formatter ->
          ('a -> 'b) Ctypes.fn -> unit
 
-val case : concurrency:[ `Sequential | `Lwt_jobs | `Unlocked ] ->
+val case : concurrency:[ `Sequential | `Lwt_jobs | `Lwt_preemptive | `Unlocked ] ->
          errno:[ `Ignore_errno | `Return_errno ] ->
          stub_name:string -> external_name:string -> Format.formatter ->
          ('a -> 'b) Ctypes.fn -> unit
 
 val val_case : stub_name:string -> external_name:string -> Format.formatter ->
          'a Ctypes.typ -> unit
 
-val constructor_decl : concurrency:[ `Sequential | `Lwt_jobs | `Unlocked ] ->
+val constructor_decl : concurrency:[ `Sequential | `Lwt_jobs | `Lwt_preemptive | `Unlocked ] ->
   errno:[ `Ignore_errno | `Return_errno ] ->
   string -> 'a Ctypes.fn -> Format.formatter -> unit
 

tests/test-lwt-preemptive/stub-generator/driver.ml

@@ -0,0 +1,18 @@
+(*
+ * Copyright (c) 2016 Jeremy Yallop.
+ *
+ * This file is distributed under the terms of the MIT License.
+ * See the file LICENSE for details.
+ *)
+
+(* Stub generation driver for the Lwt preemptive tests. *)
+
+let cheader = "#include <math.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <unistd.h>
+"
+
+let () = Tests_common.run ~cheader Sys.argv (module Functions.Stubs)
+    ~structs:(module Types.Struct_stubs)
+    ~concurrency:Cstubs.lwt_preemptive