From 924b7091d4aa669abde46589caf0e06537de0814 Mon Sep 17 00:00:00 2001
From: Jeremy Yallop <yallop@gmail.com>
Date: Mon, 23 May 2016 16:56:25 +0100
Subject: [PATCH 01/11] Add an ~errno argument to the code generation
 functions.

---
 src/cstubs/cstubs.ml  | 29 ++++++++++++++++++++---------
 src/cstubs/cstubs.mli | 12 ++++++++++--
 2 files changed, 30 insertions(+), 11 deletions(-)

diff --git a/src/cstubs/cstubs.ml b/src/cstubs/cstubs.ml
index 74f8e4ea..3896b252 100644
--- a/src/cstubs/cstubs.ml
+++ b/src/cstubs/cstubs.ml
@@ -25,6 +25,8 @@ module type BINDINGS = functor (F : FOREIGN') -> sig end
 
 type concurrency_policy = [ `Sequential | `Lwt_jobs ]
 
+type errno_policy = [`Ignore_errno ]
+
 let gen_c ~concurrency prefix fmt : (module FOREIGN') =
   (module
    struct
@@ -145,19 +147,28 @@ let gen_ml ~concurrency prefix fmt : (module FOREIGN') * (unit -> unit) =
 
 let sequential = `Sequential
 let lwt_jobs = `Lwt_jobs
+let ignore_errno = `Ignore_errno
+
+let concurrency_headers = function
+    `Sequential -> []
+  | `Lwt_jobs ->   ["\"lwt_unix.h\"";  "<caml/memory.h>"]
+
+let errno_headers = function
+  `Ignore_errno -> []
 
-let headers : concurrency_policy -> string list = function
-    `Sequential -> ["\"ctypes_cstubs_internals.h\""]
-  | `Lwt_jobs ->   ["\"ctypes_cstubs_internals.h\"";
-                    "\"lwt_unix.h\"";
-                    "<errno.h>";
-                    "<caml/memory.h>"]
+let headers : concurrency_policy -> errno_policy -> string list =
+  fun concurrency errno ->
+    ["\"ctypes_cstubs_internals.h\""] @
+    errno_headers errno @
+    concurrency_headers concurrency
 
-let write_c ?(concurrency=`Sequential) fmt ~prefix (module B : BINDINGS) =
-  List.iter (Format.fprintf fmt "#include %s@\n") (headers concurrency);
+let write_c ?(concurrency=`Sequential) ?(errno=`Ignore_errno)
+    fmt ~prefix (module B : BINDINGS) =
+  List.iter (Format.fprintf fmt "#include %s@\n") (headers concurrency errno);
   let module M = B((val gen_c ~concurrency prefix fmt)) in ()
 
-let write_ml ?(concurrency=`Sequential) fmt ~prefix (module B : BINDINGS) =
+let write_ml ?(concurrency=`Sequential) ?(errno=`Ignore_errno)
+    fmt ~prefix (module B : BINDINGS) =
   let foreign, finally = gen_ml ~concurrency prefix fmt in
   let () = Format.fprintf fmt "module CI = Cstubs_internals@\n@\n" in
   let module M = B((val foreign)) in
diff --git a/src/cstubs/cstubs.mli b/src/cstubs/cstubs.mli
index 122c023e..fbd11b23 100644
--- a/src/cstubs/cstubs.mli
+++ b/src/cstubs/cstubs.mli
@@ -83,6 +83,14 @@ end
 
 module type BINDINGS = functor (F : FOREIGN with type 'a result = unit) -> sig end
 
+type errno_policy
+(** Values of the [errno_policy] type specify the errno support provided by
+    the generated code.  See {!ignore_errno} for the available option.
+*)
+
+val ignore_errno : errno_policy
+(** Generate code with no special support for errno.  This is the default. *)
+
 type concurrency_policy
 (** Values of the [concurrency_policy] type specify the concurrency support
     provided by the generated code.  See {!sequential} and {!lwt_jobs} for the
@@ -114,7 +122,7 @@ val lwt_jobs : concurrency_policy
        [val unlink : string -> int Lwt.t]
 *)
 
-val write_c : ?concurrency:concurrency_policy ->
+val write_c : ?concurrency:concurrency_policy -> ?errno:errno_policy ->
   Format.formatter -> prefix:string -> (module BINDINGS) -> unit
 (** [write_c fmt ~prefix bindings] generates C stubs for the functions bound
     with [foreign] in [bindings].  The stubs are intended to be used in
@@ -127,7 +135,7 @@ val write_c : ?concurrency:concurrency_policy ->
     [ctypes_cstubs_internals.h].
 *)
 
-val write_ml : ?concurrency:concurrency_policy ->
+val write_ml : ?concurrency:concurrency_policy -> ?errno:errno_policy ->
   Format.formatter -> prefix:string -> (module BINDINGS) -> unit
 (** [write_ml fmt ~prefix bindings] generates ML bindings for the functions
     bound with [foreign] in [bindings].  The generated code conforms to the

From 9197aa806462df54891d0d6a178f8b97cf386c35 Mon Sep 17 00:00:00 2001
From: Jeremy Yallop <yallop@gmail.com>
Date: Mon, 23 May 2016 17:09:19 +0100
Subject: [PATCH 02/11] Add a second errno_policy option, return_errno.

---
 src/cstubs/cstubs.ml  |  6 ++++--
 src/cstubs/cstubs.mli | 24 ++++++++++++++++++++++++
 2 files changed, 28 insertions(+), 2 deletions(-)

diff --git a/src/cstubs/cstubs.ml b/src/cstubs/cstubs.ml
index 3896b252..601f93ee 100644
--- a/src/cstubs/cstubs.ml
+++ b/src/cstubs/cstubs.ml
@@ -25,7 +25,7 @@ module type BINDINGS = functor (F : FOREIGN') -> sig end
 
 type concurrency_policy = [ `Sequential | `Lwt_jobs ]
 
-type errno_policy = [`Ignore_errno ]
+type errno_policy = [ `Ignore_errno | `Return_errno ]
 
 let gen_c ~concurrency prefix fmt : (module FOREIGN') =
   (module
@@ -148,13 +148,15 @@ let gen_ml ~concurrency prefix fmt : (module FOREIGN') * (unit -> unit) =
 let sequential = `Sequential
 let lwt_jobs = `Lwt_jobs
 let ignore_errno = `Ignore_errno
+let return_errno = `Return_errno
 
 let concurrency_headers = function
     `Sequential -> []
   | `Lwt_jobs ->   ["\"lwt_unix.h\"";  "<caml/memory.h>"]
 
 let errno_headers = function
-  `Ignore_errno -> []
+    `Ignore_errno -> []
+  | `Return_errno -> ["<errno.h>"]
 
 let headers : concurrency_policy -> errno_policy -> string list =
   fun concurrency errno ->
diff --git a/src/cstubs/cstubs.mli b/src/cstubs/cstubs.mli
index fbd11b23..3962366e 100644
--- a/src/cstubs/cstubs.mli
+++ b/src/cstubs/cstubs.mli
@@ -91,6 +91,30 @@ type errno_policy
 val ignore_errno : errno_policy
 (** Generate code with no special support for errno.  This is the default. *)
 
+val return_errno : errno_policy
+(** Generate code that returns errno in addition to the return value of each function.
+
+    Passing [return_errno] as the [errno] argument to {!Cstubs.write_c} and
+    {!Cstubs.write_ml} changes the return type of bound functions from a
+    single value to a pair of values.  For example, the binding
+    specification 
+
+       [let realpath = foreign "reaplath" (string @-> string @-> returning string)]
+
+    generates a value of the following type by default:
+
+       [val realpath : string -> string -> stirng]
+
+    but when using [return_errno] the generated type is as follows:
+
+       [val realpath : string -> string -> stirng * int]
+
+    and when using both [return_errno] and [lwt_jobs] the generated type is as
+    follows:
+
+       [val realpath : string -> string -> (stirng * int) Lwt.t]
+*)
+
 type concurrency_policy
 (** Values of the [concurrency_policy] type specify the concurrency support
     provided by the generated code.  See {!sequential} and {!lwt_jobs} for the

From f7d43c80b2de844dd4cd1e55229177d649a23a12 Mon Sep 17 00:00:00 2001
From: Jeremy Yallop <yallop@gmail.com>
Date: Tue, 24 May 2016 10:52:32 +0100
Subject: [PATCH 03/11] Rename test-errno to reflect the fact that it's
 Foreign-specific.

---
 Makefile.tests                                     | 14 +++++++-------
 .../test_errno.ml                                  |  2 +-
 2 files changed, 8 insertions(+), 8 deletions(-)
 rename tests/{test-errno => test-foreign-errno}/test_errno.ml (97%)

diff --git a/Makefile.tests b/Makefile.tests
index c1c3b7b5..3f8f3535 100644
--- a/Makefile.tests
+++ b/Makefile.tests
@@ -494,12 +494,12 @@ tests/test-arrays/generated_stubs.c: $(BUILDDIR)/test-arrays-stub-generator.nati
 tests/test-arrays/generated_bindings.ml: $(BUILDDIR)/test-arrays-stub-generator.native
 	$< --ml-file $@
 
-test-errno.dir = tests/test-errno
-test-errno.threads = yes
-test-errno.deps = str bigarray oUnit bytes
-test-errno.subproject_deps = ctypes ctypes-foreign-base ctypes-foreign-threaded
-test-errno: PROJECT=test-errno
-test-errno: $$(NATIVE_TARGET)
+test-foreign-errno.dir = tests/test-foreign-errno
+test-foreign-errno.threads = yes
+test-foreign-errno.deps = str bigarray oUnit bytes
+test-foreign-errno.subproject_deps = ctypes ctypes-foreign-base ctypes-foreign-threaded
+test-foreign-errno: PROJECT=test-foreign-errno
+test-foreign-errno: $$(NATIVE_TARGET)
 
 test-passable.dir = tests/test-passable
 test-passable.threads = yes
@@ -908,7 +908,7 @@ TESTS += test-foreign_values-stubs test-foreign_values-stub-generator test-forei
 TESTS += test-unions-stubs test-unions-stub-generator test-unions-generated test-unions
 TESTS += test-custom_ops
 TESTS += test-arrays-stubs test-arrays-stub-generator test-arrays-generated test-arrays
-TESTS += test-errno
+TESTS += test-foreign-errno
 TESTS += test-passable
 TESTS += test-alignment
 TESTS += test-views-stubs test-views-stub-generator test-views-generated test-views
diff --git a/tests/test-errno/test_errno.ml b/tests/test-foreign-errno/test_errno.ml
similarity index 97%
rename from tests/test-errno/test_errno.ml
rename to tests/test-foreign-errno/test_errno.ml
index 90b73f99..38d198ce 100644
--- a/tests/test-errno/test_errno.ml
+++ b/tests/test-foreign-errno/test_errno.ml
@@ -48,7 +48,7 @@ let test_errno_no_exception_raised _ =
 
     
 
-let suite = "errno tests" >:::
+let suite = "foreign+errno tests" >:::
   ["Exception from close"
     >:: test_errno_exception_raised;
 

From d2106a17321fe5b2e14c803272d1274e0eddcc28 Mon Sep 17 00:00:00 2001
From: Jeremy Yallop <yallop@gmail.com>
Date: Tue, 24 May 2016 11:06:47 +0100
Subject: [PATCH 04/11] Test returning errno from Lwt-jobs bindings.

---
 Makefile.tests                                | 42 +++++++++++++++++++
 .../stub-generator/driver.ml                  | 20 +++++++++
 .../stubs/functions.ml                        | 19 +++++++++
 tests/test-returning-errno-lwt/stubs/types.ml | 23 ++++++++++
 .../test_returning_errno.ml                   | 42 +++++++++++++++++++
 tests/tests-common/tests_common.ml            |  8 ++--
 6 files changed, 151 insertions(+), 3 deletions(-)
 create mode 100644 tests/test-returning-errno-lwt/stub-generator/driver.ml
 create mode 100644 tests/test-returning-errno-lwt/stubs/functions.ml
 create mode 100644 tests/test-returning-errno-lwt/stubs/types.ml
 create mode 100644 tests/test-returning-errno-lwt/test_returning_errno.ml

diff --git a/Makefile.tests b/Makefile.tests
index 3f8f3535..8155211f 100644
--- a/Makefile.tests
+++ b/Makefile.tests
@@ -875,6 +875,47 @@ $(BUILDDIR)/test-lwt-jobs-ml-stub-generator.native: $(BUILDDIR)/tests/test-lwt-j
 $(BUILDDIR)/tests/test-lwt-jobs/generated_struct_stubs.c: $(BUILDDIR)/test-lwt-jobs-stub-generator.native
 	$< --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 \
+   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: $$(NATIVE_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: $$(NATIVE_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.native
+	$< --c-file $@
+tests/test-returning-errno-lwt/generated_bindings.ml: $(BUILDDIR)/test-returning-errno-lwt-stub-generator.native
+	$< --ml-file $@
+tests/test-returning-errno-lwt/generated_struct_bindings.ml: $(BUILDDIR)/test-returning-errno-lwt-ml-stub-generator.native
+	$< > $@
+$(BUILDDIR)/test-returning-errno-lwt-ml-stub-generator.native: $(BUILDDIR)/tests/test-returning-errno-lwt/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.native
+	$< --c-struct-file $@
+
+
 test-threads-stubs.dir  = tests/test-threads/stubs
 test-threads-stubs.threads = yes
 test-threads-stubs.subproject_deps = ctypes cstubs \
@@ -924,6 +965,7 @@ 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-threads-stubs test-threads
 
 
diff --git a/tests/test-returning-errno-lwt/stub-generator/driver.ml b/tests/test-returning-errno-lwt/stub-generator/driver.ml
new file mode 100644
index 00000000..1c7d9202
--- /dev/null
+++ b/tests/test-returning-errno-lwt/stub-generator/driver.ml
@@ -0,0 +1,20 @@
+(*
+ * 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 errno tests. *)
+
+let cheader = "#include <stdlib.h>
+#include <errno.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_jobs
+    ~errno:Cstubs.return_errno
diff --git a/tests/test-returning-errno-lwt/stubs/functions.ml b/tests/test-returning-errno-lwt/stubs/functions.ml
new file mode 100644
index 00000000..4d829b04
--- /dev/null
+++ b/tests/test-returning-errno-lwt/stubs/functions.ml
@@ -0,0 +1,19 @@
+(*
+ * Copyright (c) 2016 Jeremy Yallop.
+ *
+ * This file is distributed under the terms of the MIT License.
+ * See the file LICENSE for details.
+ *)
+
+(* Foreign function bindings for the Errno tests. *)
+
+open Ctypes
+
+module Stubs (F: Cstubs.FOREIGN) =
+struct
+  open F
+
+  let struct_stat : [`stat] structure typ = structure "stat"
+  let stat = foreign "stat"
+      (string @-> ptr struct_stat @-> returning int)
+end
diff --git a/tests/test-returning-errno-lwt/stubs/types.ml b/tests/test-returning-errno-lwt/stubs/types.ml
new file mode 100644
index 00000000..634dcb23
--- /dev/null
+++ b/tests/test-returning-errno-lwt/stubs/types.ml
@@ -0,0 +1,23 @@
+(*
+ * Copyright (c) 2016 Jeremy Yallop.
+ *
+ * This file is distributed under the terms of the MIT License.
+ * See the file LICENSE for details.
+ *)
+
+open Ctypes
+open PosixTypes
+
+module Struct_stubs(S : Cstubs.Types.TYPE) =
+struct
+  open S
+
+  let _ENOENT = constant "ENOENT" int
+
+  let ifdir = constant "S_IFDIR" (lift_typ mode_t)
+  let ifmt = constant "S_IFMT" (lift_typ mode_t)
+
+  let stat : [`stat] structure typ = structure "stat"
+  let st_mode = field stat "st_mode" (lift_typ mode_t)
+  let () = seal stat
+end
diff --git a/tests/test-returning-errno-lwt/test_returning_errno.ml b/tests/test-returning-errno-lwt/test_returning_errno.ml
new file mode 100644
index 00000000..688d635f
--- /dev/null
+++ b/tests/test-returning-errno-lwt/test_returning_errno.ml
@@ -0,0 +1,42 @@
+(*
+ * Copyright (c) 2016 Jeremy Yallop.
+ *
+ * This file is distributed under the terms of the MIT License.
+ * See the file LICENSE for details.
+ *)
+
+open OUnit2
+open Ctypes
+
+
+module Bindings = Functions.Stubs(Generated_bindings)
+module Constants = Types.Struct_stubs(Generated_struct_bindings)
+
+
+(*
+  Test the binding to "stat".
+ *)
+let test_stat _ =
+  let s = make Constants.stat in
+  begin
+    Lwt_unix.run
+      Lwt.((Bindings.stat "." (addr s)).lwt >>= fun (x, errno) ->
+           assert_equal 0 x;
+           assert_equal 0 errno;
+           return ());
+    Lwt_unix.run
+      Lwt.((Bindings.stat "/does-not-exist" (addr s)).lwt >>= fun (x, errno) ->
+           assert_equal (-1) x;
+           assert_equal Constants._ENOENT errno;
+           return ())
+  end
+
+
+let suite = "Errno tests" >:::
+  ["calling stat"
+    >:: test_stat;
+  ]
+
+
+let _ =
+  run_test_tt_main suite
diff --git a/tests/tests-common/tests_common.ml b/tests/tests-common/tests_common.ml
index 334fa38b..474e5a7f 100644
--- a/tests/tests-common/tests_common.ml
+++ b/tests/tests-common/tests_common.ml
@@ -57,17 +57,19 @@ let with_open_formatter filename f =
 
 let header = "#include \"clib/test_functions.h\""
 
-let run ?concurrency ?(cheader="") argv ?structs specs =
+let run ?concurrency ?errno ?(cheader="") argv ?structs specs =
   let ml_filename, c_filename, c_struct_filename = filenames argv
   in
   if ml_filename <> "" then
     with_open_formatter ml_filename
-      (fun fmt -> Cstubs.write_ml ?concurrency fmt ~prefix:"cstubs_tests" specs);
+      (fun fmt -> Cstubs.write_ml ?concurrency ?errno
+          fmt ~prefix:"cstubs_tests" specs);
   if c_filename <> "" then
     with_open_formatter c_filename
       (fun fmt -> 
         Format.fprintf fmt "%s@\n%s@\n" header cheader;
-        Cstubs.write_c ?concurrency fmt ~prefix:"cstubs_tests" specs);
+        Cstubs.write_c ?concurrency ?errno
+          fmt ~prefix:"cstubs_tests" specs);
   begin match structs, c_struct_filename with
    | None, _ -> ()
    | Some _, "" -> ()

From 3216cdb3a161352448ea310bf2f9c932eb085d89 Mon Sep 17 00:00:00 2001
From: Jeremy Yallop <yallop@gmail.com>
Date: Tue, 24 May 2016 12:26:53 +0100
Subject: [PATCH 05/11] Add C code generation for Lwt-jobs bindings that return
 errno.

---
 src/cstubs/cstubs.ml             |  6 +--
 src/cstubs/cstubs_generate_c.ml  | 74 +++++++++++++++++++++++---------
 src/cstubs/cstubs_generate_c.mli |  1 +
 3 files changed, 58 insertions(+), 23 deletions(-)

diff --git a/src/cstubs/cstubs.ml b/src/cstubs/cstubs.ml
index 601f93ee..2407b10a 100644
--- a/src/cstubs/cstubs.ml
+++ b/src/cstubs/cstubs.ml
@@ -27,7 +27,7 @@ type concurrency_policy = [ `Sequential | `Lwt_jobs ]
 
 type errno_policy = [ `Ignore_errno | `Return_errno ]
 
-let gen_c ~concurrency prefix fmt : (module FOREIGN') =
+let gen_c ~concurrency ~errno prefix fmt : (module FOREIGN') =
   (module
    struct
      let counter = ref 0
@@ -37,7 +37,7 @@ let gen_c ~concurrency prefix fmt : (module FOREIGN') =
      type 'a return = 'a
      type 'a result = unit
      let foreign cname fn =
-       Cstubs_generate_c.fn ~concurrency
+       Cstubs_generate_c.fn ~concurrency ~errno
          ~cname ~stub_name:(var prefix cname) fmt fn
      let foreign_value cname typ =
        Cstubs_generate_c.value ~cname ~stub_name:(var prefix cname) fmt typ
@@ -167,7 +167,7 @@ let headers : concurrency_policy -> errno_policy -> string list =
 let write_c ?(concurrency=`Sequential) ?(errno=`Ignore_errno)
     fmt ~prefix (module B : BINDINGS) =
   List.iter (Format.fprintf fmt "#include %s@\n") (headers concurrency errno);
-  let module M = B((val gen_c ~concurrency prefix fmt)) in ()
+  let module M = B((val gen_c ~concurrency ~errno prefix fmt)) in ()
 
 let write_ml ?(concurrency=`Sequential) ?(errno=`Ignore_errno)
     fmt ~prefix (module B : BINDINGS) =
diff --git a/src/cstubs/cstubs_generate_c.ml b/src/cstubs/cstubs_generate_c.ml
index 1f52e07e..5415381d 100644
--- a/src/cstubs/cstubs_generate_c.ml
+++ b/src/cstubs/cstubs_generate_c.ml
@@ -87,6 +87,10 @@ struct
                                   references_ocaml_heap = true;
                                   typ = Ty value }
 
+  let errno : ceff = `Global { name = "errno";
+                               references_ocaml_heap = false;
+                               typ = Ty int }
+
   let functions : ceff = `Global
     { name = "functions";
       references_ocaml_heap = true;
@@ -327,17 +331,21 @@ struct
   let structure_type stub_name = 
     structure (sprintf "job_%s" stub_name)
 
-  let structure ~stub_name fmt fn args result =
+  let structure ~errno ~stub_name fmt fn args result =
     let open Ctypes in
     let s = structure_type stub_name in
     let (_ : (_,_) field) = field s "job" lwt_unix_job in
     let (_ : (_,_) field) = field s "result" result in
+    let () = match errno with
+        `Ignore_errno -> ()
+      | `Return_errno -> ignore (field s "error_status" int)
+    in
     let () = ListLabels.iter args
         ~f:(fun (BoxedType t, name) -> ignore (field s name t : (_,_) field)) in
     let () = seal s in
     fprintf fmt "@[%a@];@\n" (fun t -> format_typ t) s
     
-  let worker ~cname ~stub_name fmt f result args =
+  let worker ~errno ~cname ~stub_name fmt f result args =
     let fn' = { fname = cname;
                allocates = false;
                reads_ocaml_heap = false;
@@ -345,9 +353,22 @@ struct
     and j = "j", Ty (ptr (structure_type stub_name)) in
     let rec body args : _ -> ccomp = function
         [] ->
-        `LetAssign (`PointerField (`Local j, "result"),
-                    `App (fn', List.rev args),
-                    `Return (Ty Void, `Int 0))
+        let r c =
+          Generate_C.cast ~from:(Ty result) ~into:(Ty Void)
+            (`LetAssign (`PointerField (`Local j, "result"),
+                         `App (fn', List.rev args),
+                         c))
+        in
+        begin match errno with
+            `Ignore_errno -> r (`Return (Ty Void, (`Int 0)))
+          | `Return_errno ->
+            let open Generate_C in
+              r
+              (`LetAssign
+                 (`PointerField (`Local j, "error_status"),
+                  errno,
+                  `Return (Ty Void, (`Int 0))))
+        end
       | (BoxedType ty, x) :: xs ->
         Generate_C.((`DerefField (`Local j, x), ty) >>= fun y ->
                     body (y :: args) xs)
@@ -357,24 +378,32 @@ struct
                   body [] args,
                   `Static))
 
-  let result ~stub_name fmt fn result =
+  let result ~errno ~stub_name fmt fn result =
     begin
       fprintf fmt "@[static@ value@ result_%s@;@[(struct@ job_%s@ *j)@]@]@;@[<2>{@\n"
         stub_name stub_name;
       fprintf fmt "@[CAMLparam0@ ();@]@\n";
       fprintf fmt "@[CAMLlocal1@ (rv);@]@\n";
-      fprintf fmt "@[rv@ =@ (%a);@]@\n"
-        (fun fmt ty ->
-           Cstubs_emit_c.ceff fmt
-             (Generate_C.inj ty
-                (`Local ("j->result", Cstubs_c_language.(Ty ty)))))
-        result;
+      let () = match errno with
+          `Ignore_errno ->
+          fprintf fmt "@[rv@ =@ (";
+        | `Return_errno ->
+          fprintf fmt "@[rv@ =@ caml_alloc_tuple(2);@]@\n";
+          fprintf fmt "@[Store_field(rv,@ 1,@ Val_int(j->error_status));@]@\n";
+          fprintf fmt "@[Store_field(rv,@ 0,@ ";
+      in
+          fprintf fmt "%a);@]@\n"
+            (fun fmt ty ->
+               Cstubs_emit_c.ceff fmt
+                 (Generate_C.inj ty
+                    (`Local ("j->result", Cstubs_c_language.(Ty ty)))))
+            result;
       fprintf fmt "@[lwt_unix_free_job(&j->job)@];@\n";
       fprintf fmt "@[CAMLreturn@ (rv)@];@]@\n";
       fprintf fmt "}@\n";
     end
 
-  let stub ~stub_name fmt fn args =
+  let stub ~errno ~stub_name fmt fn args =
     begin
       fprintf fmt "@[value@ %s@;@[(%s)@]@]@;@[<2>{@\n"
         stub_name
@@ -385,6 +414,11 @@ struct
 
       fprintf fmt "@[LWT_UNIX_INIT_JOB(job,@ %s,@ 0)@];@\n"
         stub_name;
+      let () = match errno with
+          `Ignore_errno -> ()
+        | `Return_errno ->
+          fprintf fmt  "@[job->error_status@ =@ 0@];@\n"
+      in
       ListLabels.iter args
         ~f:(fun (BoxedType t, x) ->
             fprintf fmt "@[job->%s@ =@ %a@];@\n" x
@@ -408,17 +442,17 @@ struct
         | Returns t -> List.rev args, BoxedType t
      in aux fn []  
 
-  let fn ~cname ~stub_name fmt fn =
+  let fn ~errno ~cname ~stub_name fmt fn =
     let args, BoxedType r = fn_args_and_result fn in
     begin
-      structure ~stub_name fmt fn args r;
-      worker ~cname ~stub_name fmt fn r args;
-      result ~stub_name fmt fn r;
-      stub ~stub_name fmt fn args;
+      structure ~errno ~stub_name fmt fn args r;
+      worker ~errno ~cname ~stub_name fmt fn r args;
+      result ~errno ~stub_name fmt fn r;
+      stub ~errno ~stub_name fmt fn args;
       fprintf fmt "@\n";
     end
 end
 
-let fn ~concurrency = match concurrency with
+let fn ~concurrency ~errno = match concurrency with
     `Sequential -> fn
-  | `Lwt_jobs -> Lwt.fn
+  | `Lwt_jobs -> Lwt.fn ~errno
diff --git a/src/cstubs/cstubs_generate_c.mli b/src/cstubs/cstubs_generate_c.mli
index fb7ee560..ad43efba 100644
--- a/src/cstubs/cstubs_generate_c.mli
+++ b/src/cstubs/cstubs_generate_c.mli
@@ -8,6 +8,7 @@
 (* C stub generation *)
 
 val fn : concurrency:[ `Sequential | `Lwt_jobs ] ->
+         errno:[ `Ignore_errno | `Return_errno ] ->
          cname:string -> stub_name:string ->
          Format.formatter -> 'a Ctypes.fn -> unit
 

From 4a6ce09f87a9dc0846645b40029d3c332465d119 Mon Sep 17 00:00:00 2001
From: Jeremy Yallop <yallop@gmail.com>
Date: Wed, 25 May 2016 11:59:31 +0100
Subject: [PATCH 06/11] ML code generation: add support for pair types.

---
 src/cstubs/cstubs_generate_ml.ml | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/cstubs/cstubs_generate_ml.ml b/src/cstubs/cstubs_generate_ml.ml
index 1089aa7c..f0c4a96a 100644
--- a/src/cstubs/cstubs_generate_ml.ml
+++ b/src/cstubs/cstubs_generate_ml.ml
@@ -16,6 +16,7 @@ type concurrency_policy = [ `Sequential | `Lwt_jobs ]
 type lident = string
 type ml_type = [ `Ident of path
                | `Appl of path * ml_type list
+               | `Pair of ml_type * ml_type
                | `Fn of ml_type * ml_type ]
 
 type ml_external_type = [ `Prim of ml_type list * ml_type ]
@@ -92,6 +93,8 @@ struct
       fprintf fmt "@[(%a@ ->@ %a)@]" (ml_type ArrowParens) t (ml_type NoArrowParens) t'
     | NoArrowParens, `Fn (t, t') ->
       fprintf fmt "@[%a@ ->@]@ %a" (ml_type ArrowParens) t (ml_type NoArrowParens) t'
+    | _, `Pair (t, t') ->
+      fprintf fmt "@[(%a@ *@ %a)@]" (ml_type NoArrowParens) t (ml_type NoArrowParens) t'
 
   let ml_external_type fmt (`Prim (args, ret) : ml_external_type) =
     List.iter (fprintf fmt "@[%a@ ->@]@ " (ml_type ArrowParens)) args;

From 06dbaec45ae164d7348e422827017ea84ef0b203 Mon Sep 17 00:00:00 2001
From: Jeremy Yallop <yallop@gmail.com>
Date: Tue, 24 May 2016 16:56:59 +0100
Subject: [PATCH 07/11] Add ML code generation for bindings that return errno.

---
 src/cstubs/cstubs.ml              |  82 +++++++++++----------
 src/cstubs/cstubs_generate_ml.ml  | 117 +++++++++++++++++-------------
 src/cstubs/cstubs_generate_ml.mli |   3 +
 src/cstubs/cstubs_inverted.ml     |   5 +-
 4 files changed, 115 insertions(+), 92 deletions(-)

diff --git a/src/cstubs/cstubs.ml b/src/cstubs/cstubs.ml
index 2407b10a..428670c7 100644
--- a/src/cstubs/cstubs.ml
+++ b/src/cstubs/cstubs.ml
@@ -48,56 +48,58 @@ let gen_c ~concurrency ~errno prefix fmt : (module FOREIGN') =
 type bind = Bind : string * string * ('a -> 'b) Ctypes.fn -> bind
 type val_bind = Val_bind : string * string * 'a Ctypes.typ -> val_bind
 
-let write_return : concurrency:concurrency_policy -> Format.formatter -> unit =
-  fun ~concurrency fmt -> match concurrency with
-      `Sequential -> Format.fprintf fmt "type 'a return = 'a@\n"
-    | `Lwt_jobs ->
+let write_return :
+  concurrency:concurrency_policy -> errno:errno_policy ->
+  Format.formatter -> unit =
+  fun ~concurrency ~errno fmt -> match concurrency, errno with
+      `Sequential, `Ignore_errno -> Format.fprintf fmt "type 'a return = 'a@\n"
+    | `Sequential, `Return_errno -> Format.fprintf fmt "type 'a return = 'a * int@\n"
+    | `Lwt_jobs, `Ignore_errno ->
       begin
         Format.fprintf fmt "type 'a return = { lwt: 'a Lwt.t }@\n";
         Format.fprintf fmt "let box_lwt lwt = {lwt}@\n";
       end
-
-let write_fn : concurrency:concurrency_policy -> Format.formatter -> unit =
-  fun ~concurrency fmt -> match concurrency with
-      `Sequential ->
-      begin
-        Format.fprintf fmt
-          "type 'a fn = 'a CI.fn = @\n";
-        Format.fprintf fmt
-          " | Returns  : 'a CI.typ   -> 'a return fn@\n";
-        Format.fprintf fmt
-          " | Function : 'a CI.typ * 'b fn  -> ('a -> 'b) fn@\n";
-        Format.fprintf fmt
-          "let returning t = CI.Returns t@\n";
-        Format.fprintf fmt
-          "let (@@->) f p = CI.Function (f, p)@\n";
-      end
-    | `Lwt_jobs ->
+    | `Lwt_jobs, `Return_errno ->
       begin
-        Format.fprintf fmt
-          "type 'a fn = @\n";
-        Format.fprintf fmt
-          " | Returns  : 'a CI.typ   -> 'a return fn@\n";
-        Format.fprintf fmt
-          " | Function : 'a CI.typ * 'b fn  -> ('a -> 'b) fn@\n";
-        Format.fprintf fmt
-          "let returning t = Returns t@\n";
-        Format.fprintf fmt
-          "let (@@->) f p = Function (f, p)@\n";
+        Format.fprintf fmt "type 'a return = { lwt: ('a * int) Lwt.t }@\n";
+        Format.fprintf fmt "let box_lwt lwt = {lwt}@\n";
       end
 
-let write_foreign ~concurrency fmt bindings val_bindings =
+let write_fn ~concurrency ~errno fmt =
+  begin
+    Format.fprintf fmt "type 'a fn =@\n";
+    Format.fprintf fmt " | Returns  : 'a CI.typ   -> 'a return fn@\n";
+    Format.fprintf fmt " | Function : 'a CI.typ * 'b fn  -> ('a -> 'b) fn@\n"
+  end
+
+let write_map_result ~concurrency ~errno fmt =
+  match concurrency, errno with
+    `Sequential, `Ignore_errno ->
+    Format.fprintf fmt "let map_result f x = f x@\n"
+  | `Sequential, `Return_errno ->
+    Format.fprintf fmt "let map_result f (x, y) = (f x, y)@\n"
+  | `Lwt_jobs, `Ignore_errno ->
+    Format.fprintf fmt "let map_result f x = Lwt.map f x@\n"
+  | `Lwt_jobs, `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 =
   Format.fprintf fmt
     "type 'a result = 'a@\n";
-  write_return ~concurrency fmt;
-  write_fn ~concurrency fmt;
+  write_return ~concurrency ~errno fmt;
+  write_fn ~concurrency ~errno fmt;
+  write_map_result ~concurrency ~errno fmt;
+  Format.fprintf fmt
+    "let returning t = Returns t@\n";
+  Format.fprintf fmt
+    "let (@@->) f p = Function (f, p)@\n";
   Format.fprintf fmt
     "let foreign : type a b. string -> (a -> b) fn -> (a -> b) =@\n";
   Format.fprintf fmt
     "  fun name t -> match t, name with@\n@[<v>";
   ListLabels.iter bindings
     ~f:(fun (Bind (stub_name, external_name, fn)) ->
-      Cstubs_generate_ml.case ~concurrency ~stub_name ~external_name fmt fn);
+      Cstubs_generate_ml.case ~concurrency ~errno ~stub_name ~external_name fmt fn);
   Format.fprintf fmt "@[<hov 2>@[|@ _,@ s@ ->@]@ ";
   Format.fprintf fmt
     " @[Printf.ksprintf@ failwith@ \"No match for %%s\" s@]@]@]@.@\n";
@@ -114,7 +116,7 @@ let write_foreign ~concurrency fmt bindings val_bindings =
   Format.fprintf fmt
     " @[Printf.ksprintf@ failwith@ \"No match for %%s\" s@]@]@]@.@\n"
 
-let gen_ml ~concurrency prefix fmt : (module FOREIGN') * (unit -> unit) =
+let gen_ml ~concurrency ~errno prefix fmt : (module FOREIGN') * (unit -> unit) =
   let bindings = ref []
   and val_bindings = ref []
   and counter = ref 0 in
@@ -131,11 +133,11 @@ let gen_ml ~concurrency prefix fmt : (module FOREIGN') * (unit -> unit) =
      let foreign cname fn =
        let name = var prefix cname in
        bindings := Bind (cname, name, fn) :: !bindings;
-       Cstubs_generate_ml.extern ~concurrency
+       Cstubs_generate_ml.extern ~concurrency ~errno
          ~stub_name:name ~external_name:name fmt fn
      let foreign_value cname typ =
        let name = var prefix cname in
-       Cstubs_generate_ml.extern ~concurrency:`Sequential
+       Cstubs_generate_ml.extern ~concurrency:`Sequential ~errno:`Ignore_errno
          ~stub_name:name ~external_name:name fmt
          Ctypes.(void @-> returning (ptr void));
        val_bindings := Val_bind (cname, name, typ) :: !val_bindings
@@ -143,7 +145,7 @@ let gen_ml ~concurrency prefix fmt : (module FOREIGN') * (unit -> unit) =
      let (@->) = Ctypes.(@->)
    end),
   fun () ->
-    write_foreign ~concurrency fmt !bindings !val_bindings
+    write_foreign ~concurrency ~errno fmt !bindings !val_bindings
 
 let sequential = `Sequential
 let lwt_jobs = `Lwt_jobs
@@ -171,7 +173,7 @@ let write_c ?(concurrency=`Sequential) ?(errno=`Ignore_errno)
 
 let write_ml ?(concurrency=`Sequential) ?(errno=`Ignore_errno)
     fmt ~prefix (module B : BINDINGS) =
-  let foreign, finally = gen_ml ~concurrency prefix fmt in
+  let foreign, finally = gen_ml ~concurrency ~errno prefix fmt in
   let () = Format.fprintf fmt "module CI = Cstubs_internals@\n@\n" in
   let module M = B((val foreign)) in
   finally ()
diff --git a/src/cstubs/cstubs_generate_ml.ml b/src/cstubs/cstubs_generate_ml.ml
index f0c4a96a..118eda4d 100644
--- a/src/cstubs/cstubs_generate_ml.ml
+++ b/src/cstubs/cstubs_generate_ml.ml
@@ -12,6 +12,7 @@ open Ctypes_path
 open Cstubs_errors
 
 type concurrency_policy = [ `Sequential | `Lwt_jobs ]
+type errno_policy = [ `Ignore_errno | `Return_errno ]
 
 type lident = string
 type ml_type = [ `Ident of path
@@ -282,16 +283,22 @@ let ml_typ_of_typ = function
   | Out -> ml_typ_of_return_typ
 
 let lwt_job_type = Ctypes_path.path_of_string "Lwt_unix.job"
+let int_type = `Ident (Ctypes_path.path_of_string "int")
 
 let rec ml_external_type_of_fn :
-  type a. concurrency:concurrency_policy -> a fn -> polarity -> ml_external_type =
-  fun ~concurrency fn polarity -> match fn, concurrency with
-    | Returns t, `Sequential ->
+  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, `Sequential, `Ignore_errno ->
       `Prim ([], ml_typ_of_typ polarity t)
-    | Returns t, `Lwt_jobs ->
+    | Returns t, `Sequential, `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]))
-    | Function (f, t), _ ->
-      let `Prim (l, t) = ml_external_type_of_fn ~concurrency t polarity in
+    | Returns t, `Lwt_jobs, `Return_errno ->
+      `Prim ([], `Appl (lwt_job_type, [`Pair (ml_typ_of_typ polarity t, int_type)]))
+    | Function (f, t), _, _ ->
+      let `Prim (l, t) = ml_external_type_of_fn ~concurrency ~errno t polarity in
       `Prim (ml_typ_of_typ (flip polarity) f :: l, t)
 
 let var_counter = ref 0
@@ -299,9 +306,9 @@ let fresh_var () =
   incr var_counter;
   Printf.sprintf "x%d" !var_counter
 
-let extern ~concurrency ~stub_name ~external_name fmt fn =
+let extern ~concurrency ~errno ~stub_name ~external_name fmt fn =
   let ext =
-    let typ = ml_external_type_of_fn ~concurrency fn Out in
+    let typ = ml_external_type_of_fn ~concurrency ~errno fn Out in
     ({ ident = external_name;
        typ = typ;
        primname = stub_name;
@@ -315,29 +322,34 @@ let static_con c args =
 let local_con c args =
   `Con (Ctypes_path.path_of_string c, args)
 
-let lwt_map_id = Ctypes_path.path_of_string "Lwt.map"
+let map_result_id = Ctypes_path.path_of_string "map_result"
 let make_ptr = Ctypes_path.path_of_string "CI.make_ptr"
 let make_fun_ptr = Ctypes_path.path_of_string "CI.make_fun_ptr"
 let make_structured = Ctypes_path.path_of_string "CI.make_structured"
 
-let map_result ~concurrency f e =
-  let lwt_map f x = `Appl (`Appl (`Ident lwt_map_id, f), x) in
-  match concurrency, f with
-    `Sequential, `MakePtr x -> `MakePtr (`Ident (path_of_string x), e)
-  | `Sequential, `MakeFunPtr x -> `MakeFunPtr (`Ident (path_of_string x), e)
-  | `Sequential, `MakeStructured x -> `MakeStructured (`Ident (path_of_string x), e)
-  | `Sequential, `Appl x -> `Appl (`Ident (path_of_string x), e)
-  | `Lwt_jobs, `MakePtr x -> lwt_map (`Appl (`Ident make_ptr,
-                                             `Ident (path_of_string x))) e
-  | `Lwt_jobs, `MakeFunPtr x -> lwt_map (`Appl (`Ident make_fun_ptr,
-                                                `Ident (path_of_string x))) e
-  | `Lwt_jobs, `MakeStructured x -> lwt_map (`Appl (`Ident make_structured,
-                                                    `Ident (path_of_string x))) e
-  | `Lwt_jobs, `Appl x -> lwt_map (`Ident (path_of_string x)) e
-
-let rec pattern_and_exp_of_typ : type a. concurrency:concurrency_policy ->
+let map_result ~concurrency ~errno f e =
+  let map_result f x = `Appl (`Appl (`Ident map_result_id, f), x) in
+  match concurrency, errno, f with
+    `Sequential, `Ignore_errno, `MakePtr x ->
+    `MakePtr (`Ident (path_of_string x), e)
+  | `Sequential, `Ignore_errno, `MakeFunPtr x ->
+    `MakeFunPtr (`Ident (path_of_string x), e)
+  | `Sequential, `Ignore_errno, `MakeStructured x ->
+    `MakeStructured (`Ident (path_of_string x), e)
+  | `Sequential, `Ignore_errno, `Appl x ->
+    `Appl (`Ident (path_of_string x), e)
+  | _, _, `MakePtr x ->
+    map_result (`Appl (`Ident make_ptr, `Ident (path_of_string x))) e
+  | _, _, `MakeFunPtr x ->
+    map_result (`Appl (`Ident make_fun_ptr, `Ident (path_of_string x))) e
+  | _, _, `MakeStructured x ->
+    map_result (`Appl (`Ident make_structured, `Ident (path_of_string x))) e
+  | _, _, `Appl x ->
+    map_result (`Ident (path_of_string x)) e 
+
+let rec pattern_and_exp_of_typ : type a. concurrency:concurrency_policy -> errno:errno_policy ->
   a typ -> ml_exp -> polarity -> (lident * ml_exp) list -> ml_pat * ml_exp option * (lident * ml_exp) list =
-  fun ~concurrency typ e pol binds -> match typ with
+  fun ~concurrency ~errno typ e pol binds -> match typ with
   | Void ->
     (static_con "Void" [], None, binds)
   | Primitive p ->
@@ -348,14 +360,14 @@ let rec pattern_and_exp_of_typ : type a. concurrency:concurrency_policy ->
     let pat = static_con "Pointer" [`Var x] in
     begin match pol with
     | In -> (pat, Some (`Appl (`Ident (path_of_string "CI.cptr"), e)), binds)
-    | Out -> (pat, Some (map_result ~concurrency (`MakePtr x) e), binds)
+    | Out -> (pat, Some (map_result ~concurrency ~errno (`MakePtr x) e), binds)
     end
   | Funptr _ ->
     let x = fresh_var () in
     let pat = static_con "Funptr" [`Var x] in
     begin match pol with
     | In -> (pat, Some (`Appl (`Ident (path_of_string "CI.fptr"), e)), binds)
-    | Out -> (pat, Some (map_result ~concurrency (`MakeFunPtr x) e), binds)
+    | Out -> (pat, Some (map_result ~concurrency ~errno (`MakeFunPtr x) e), binds)
     end
   | Struct _ ->
     begin match pol with
@@ -366,7 +378,7 @@ let rec pattern_and_exp_of_typ : type a. concurrency:concurrency_policy ->
     | Out ->
       let x = fresh_var () in
       let pat = `As (static_con "Struct" [`Underscore], x) in
-      (pat, Some (map_result ~concurrency (`MakeStructured x) e), binds)
+      (pat, Some (map_result ~concurrency ~errno (`MakeStructured x) e), binds)
     end
   | Union _ ->
     begin match pol with
@@ -377,7 +389,7 @@ let rec pattern_and_exp_of_typ : type a. concurrency:concurrency_policy ->
     | Out ->
       let x = fresh_var () in
       let pat = `As (static_con "Union" [`Underscore], x) in
-      (pat, Some (map_result ~concurrency (`MakeStructured x) e), binds)
+      (pat, Some (map_result ~concurrency ~errno (`MakeStructured x) e), binds)
     end
   | View { ty } ->
     begin match pol  with
@@ -386,19 +398,19 @@ let rec pattern_and_exp_of_typ : type a. concurrency:concurrency_policy ->
       let y = fresh_var () in
       let e = `Appl (`Ident (path_of_string x), e) in
       let (p, None, binds), e | (p, Some e, binds), _ =
-        pattern_and_exp_of_typ ~concurrency ty e pol binds, e in
+        pattern_and_exp_of_typ ~concurrency ~errno ty e pol binds, e in
       let pat = static_con "View"
         [`Record [path_of_string "CI.ty", p;
                   path_of_string "write", `Var x]] in
       (pat, Some (`Ident (Ctypes_path.path_of_string y)), (y, e) :: binds)
     | Out ->
       let (p, None, binds), e | (p, Some e, binds), _ =
-        pattern_and_exp_of_typ ~concurrency ty e pol binds, e in
+        pattern_and_exp_of_typ ~concurrency ~errno ty e pol binds, e in
       let x = fresh_var () in
       let pat = static_con "View"
         [`Record [path_of_string "CI.ty", p;
                   path_of_string "read", `Var x]] in
-      (pat, Some (map_result ~concurrency (`Appl x) e), binds)
+      (pat, Some (map_result ~concurrency ~errno (`Appl x) e), binds)
     end
   | OCaml ty ->
     begin match pol, ty with
@@ -480,12 +492,12 @@ let let_bind : (lident * ml_exp) list -> ml_exp -> ml_exp =
     ListLabels.fold_left ~init:e binds
       ~f:(fun e' (x, e) -> `Let (x, e, e'))
 
-let rec wrapper_body : type a. concurrency:concurrency_policy ->
+let rec wrapper_body : type a. concurrency:concurrency_policy -> errno:errno_policy ->
   a fn -> ml_exp -> polarity -> (lident * ml_exp) list -> wrapper_state =
-  fun ~concurrency fn exp pol binds -> match fn with
+  fun ~concurrency ~errno fn exp pol binds -> match fn with
   | Returns t ->
     let exp = run_exp ~concurrency exp in
-    begin match pattern_and_exp_of_typ ~concurrency t exp (flip pol) binds with
+    begin match pattern_and_exp_of_typ ~concurrency ~errno t exp (flip pol) binds with
       pat, None, binds -> { exp ; args = []; trivial = true; binds;
                             pat = local_con "Returns" [pat] }
     | pat, Some exp, binds -> { exp; args = []; trivial = false; binds;
@@ -493,15 +505,18 @@ let rec wrapper_body : type a. concurrency:concurrency_policy ->
     end
   | Function (f, t) ->
     let x = fresh_var () in
-    begin match pattern_and_exp_of_typ ~concurrency f (`Ident (path_of_string x)) pol binds with
+    begin match pattern_and_exp_of_typ ~concurrency ~errno
+                  f (`Ident (path_of_string x)) pol binds with
     | fpat, None, binds ->
       let { exp; args; trivial; pat = tpat; binds } =
-        wrapper_body ~concurrency t (`Appl (exp, `Ident (path_of_string x))) pol binds  in
+        wrapper_body ~concurrency ~errno
+          t (`Appl (exp, `Ident (path_of_string x))) pol binds  in
       { exp; args = x :: args; trivial; binds;
         pat = local_con "Function" [fpat; tpat] }
     | fpat, Some exp', binds ->
       let { exp; args = xs; trivial; pat = tpat; binds } =
-        wrapper_body ~concurrency t (`Appl (exp, exp')) pol binds in
+        wrapper_body ~concurrency ~errno
+          t (`Appl (exp, exp')) pol binds in
       { exp; args = x :: xs; trivial = false; binds;
         pat = local_con "Function" [fpat; tpat] }
     end
@@ -523,11 +538,11 @@ let return_result : args:lident list -> ml_exp =
                          ~f:(fun x -> `Ident (Ctypes_path.path_of_string x)))),
              `Appl (`Ident lwt_return, `Ident (Ctypes_path.path_of_string x))))
 
-let wrapper : type a. concurrency:concurrency_policy -> path ->
-  a fn -> string -> polarity -> ml_pat * ml_exp =
-  fun ~concurrency id fn f pol ->
-    let p = wrapper_body ~concurrency fn (`Ident (path_of_string f)) pol [], concurrency in
-    match p with
+let wrapper : type a. concurrency:concurrency_policy -> errno:errno_policy ->
+  path -> a fn -> string -> polarity -> ml_pat * ml_exp =
+  fun ~concurrency ~errno id fn f pol ->
+    let p = wrapper_body ~concurrency ~errno fn (`Ident (path_of_string f)) pol [] in
+    match p, concurrency with
       { trivial = true; pat; binds }, `Sequential ->
       (pat, let_bind binds (run_exp ~concurrency (`Ident id)))
     | { exp; args; pat; binds }, `Sequential ->
@@ -547,8 +562,9 @@ let wrapper : type a. concurrency:concurrency_policy -> path ->
                             `Appl (`Appl (`Ident lwt_bind, exp),
                                    return_result ~args:(args @ (List.map fst binds)))))))
 
-let case ~concurrency ~stub_name ~external_name fmt fn =
-  let p, e = wrapper ~concurrency (path_of_string external_name) fn external_name In in
+let case ~concurrency ~errno ~stub_name ~external_name fmt fn =
+  let p, e = wrapper ~concurrency ~errno
+      (path_of_string external_name) fn external_name In in
   Format.fprintf fmt "@[<hov 2>@[<h 2>|@ @[@[%a@],@ %S@]@ ->@]@ "
     Emit_ML.(ml_pat NoApplParens) p stub_name;
   Format.fprintf fmt "@[<hov 2>@[%a@]@]@]@." Emit_ML.(ml_exp ApplParens) e
@@ -564,13 +580,14 @@ let val_case ~stub_name ~external_name fmt typ =
     Emit_ML.(ml_exp (ApplParens)) rhs
 
 let constructor_decl : type a. concurrency:concurrency_policy ->
-  string -> a fn -> Format.formatter -> unit =
-  fun ~concurrency name fn fmt ->
+  errno:errno_policy -> string -> a fn -> Format.formatter -> unit =
+  fun ~concurrency ~errno name fn fmt ->
     Format.fprintf fmt "@[|@ %s@ : (@[%a@])@ name@]@\n" name
-      Emit_ML.ml_external_type (ml_external_type_of_fn ~concurrency fn In)
+      Emit_ML.ml_external_type (ml_external_type_of_fn ~concurrency ~errno fn In)
 
 let inverse_case ~register_name ~constructor name fmt fn : unit =
-  let p, e = wrapper ~concurrency:`Sequential (path_of_string "f") fn "f" Out in
+  let p, e = wrapper ~concurrency:`Sequential ~errno:`Ignore_errno
+      (path_of_string "f") fn "f" Out in
   Format.fprintf fmt "|@[ @[%a, %S@] -> %s %s (%a)@]@\n"
     Emit_ML.(ml_pat NoApplParens) p name register_name constructor
     Emit_ML.(ml_exp ApplParens) 
diff --git a/src/cstubs/cstubs_generate_ml.mli b/src/cstubs/cstubs_generate_ml.mli
index f930a763..3d61886d 100644
--- a/src/cstubs/cstubs_generate_ml.mli
+++ b/src/cstubs/cstubs_generate_ml.mli
@@ -8,10 +8,12 @@
 (* ML stub generation *)
 
 val extern : concurrency:[ `Sequential | `Lwt_jobs ] ->
+         errno:[ `Ignore_errno | `Return_errno ] ->
          stub_name:string -> external_name:string -> Format.formatter ->
          ('a -> 'b) Ctypes.fn -> unit
 
 val case : concurrency:[ `Sequential | `Lwt_jobs ] ->
+         errno:[ `Ignore_errno | `Return_errno ] ->
          stub_name:string -> external_name:string -> Format.formatter ->
          ('a -> 'b) Ctypes.fn -> unit
 
@@ -19,6 +21,7 @@ val val_case : stub_name:string -> external_name:string -> Format.formatter ->
          'a Ctypes.typ -> unit
 
 val constructor_decl : concurrency:[ `Sequential | `Lwt_jobs ] ->
+  errno:[ `Ignore_errno | `Return_errno ] ->
   string -> 'a Ctypes.fn -> Format.formatter -> unit
 
 val inverse_case : register_name:string -> constructor:string -> string ->
diff --git a/src/cstubs/cstubs_inverted.ml b/src/cstubs/cstubs_inverted.ml
index ab8dcdf0..961b7e02 100644
--- a/src/cstubs/cstubs_inverted.ml
+++ b/src/cstubs/cstubs_inverted.ml
@@ -134,8 +134,9 @@ let gen_ml fmt register (infos : fn_info list) : unit =
     "type 'a name = @\n";
   ListLabels.iter infos
     ~f:(fun (Fn ({fn_name}, fn)) ->
-      Cstubs_generate_ml.constructor_decl ~concurrency:`Sequential
-        (Printf.sprintf "Fn_%s" fn_name) fn fmt);
+        Cstubs_generate_ml.constructor_decl ~concurrency:`Sequential
+          ~errno:`Ignore_errno
+          (Printf.sprintf "Fn_%s" fn_name) fn fmt);
   Format.fprintf fmt
     "@\n";
   Format.fprintf fmt

From 8cb946c5c217291698cb1bae1980299223b8f1f1 Mon Sep 17 00:00:00 2001
From: Jeremy Yallop <yallop@gmail.com>
Date: Wed, 25 May 2016 14:21:33 +0100
Subject: [PATCH 08/11] Add a test for returning errno from sequential (i.e.
 non-Lwt) bindings.

---
 Makefile.tests                                | 41 +++++++++++++++++++
 .../stub-generator/driver.ml                  | 19 +++++++++
 tests/test-returning-errno/stubs/functions.ml | 19 +++++++++
 tests/test-returning-errno/stubs/types.ml     | 23 +++++++++++
 .../test_returning_errno.ml                   | 39 ++++++++++++++++++
 5 files changed, 141 insertions(+)
 create mode 100644 tests/test-returning-errno/stub-generator/driver.ml
 create mode 100644 tests/test-returning-errno/stubs/functions.ml
 create mode 100644 tests/test-returning-errno/stubs/types.ml
 create mode 100644 tests/test-returning-errno/test_returning_errno.ml

diff --git a/Makefile.tests b/Makefile.tests
index 8155211f..637a28e9 100644
--- a/Makefile.tests
+++ b/Makefile.tests
@@ -915,6 +915,46 @@ $(BUILDDIR)/test-returning-errno-lwt-ml-stub-generator.native: $(BUILDDIR)/tests
 $(BUILDDIR)/tests/test-returning-errno-lwt/generated_struct_stubs.c: $(BUILDDIR)/test-returning-errno-lwt-stub-generator.native
 	$< --c-struct-file $@
 
+test-returning-errno-stubs.dir  = tests/test-returning-errno/stubs
+test-returning-errno-stubs.threads = yes
+test-returning-errno-stubs.subproject_deps = ctypes cstubs \
+   ctypes-foreign-base ctypes-foreign-threaded tests-common
+test-returning-errno-stubs: PROJECT=test-returning-errno-stubs
+test-returning-errno-stubs: $$(LIB_TARGETS)
+
+test-returning-errno-stub-generator.dir = tests/test-returning-errno/stub-generator
+test-returning-errno-stub-generator.threads = yes
+test-returning-errno-stub-generator.subproject_deps = ctypes cstubs \
+     ctypes-foreign-base ctypes-foreign-threaded test-returning-errno-stubs tests-common
+test-returning-errno-stub-generator.deps = str bigarray bytes
+test-returning-errno-stub-generator: PROJECT=test-returning-errno-stub-generator
+test-returning-errno-stub-generator: $$(NATIVE_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.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
+test-returning-errno: PROJECT=test-returning-errno
+test-returning-errno: $$(NATIVE_TARGET)
+
+test-returning-errno-generated: \
+  tests/test-returning-errno/generated_bindings.ml \
+  tests/test-returning-errno/generated_struct_bindings.ml \
+  tests/test-returning-errno/generated_stubs.c
+
+tests/test-returning-errno/generated_stubs.c: $(BUILDDIR)/test-returning-errno-stub-generator.native
+	$< --c-file $@
+tests/test-returning-errno/generated_bindings.ml: $(BUILDDIR)/test-returning-errno-stub-generator.native
+	$< --ml-file $@
+tests/test-returning-errno/generated_struct_bindings.ml: $(BUILDDIR)/test-returning-errno-ml-stub-generator.native
+	$< > $@
+$(BUILDDIR)/test-returning-errno-ml-stub-generator.native: $(BUILDDIR)/tests/test-returning-errno/generated_struct_stubs.c
+	$(CC) -I `$(OCAMLFIND) ocamlc -where | sed 's|\r$$||'` $(CFLAGS) $(LDFLAGS) $(WINLDFLAGS) -o $@ $^
+$(BUILDDIR)/tests/test-returning-errno/generated_struct_stubs.c: $(BUILDDIR)/test-returning-errno-stub-generator.native
+	$< --c-struct-file $@
+
 
 test-threads-stubs.dir  = tests/test-threads/stubs
 test-threads-stubs.threads = yes
@@ -966,6 +1006,7 @@ 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-returning-errno-stubs test-returning-errno-stub-generator test-returning-errno-generated test-returning-errno
 TESTS += test-threads-stubs test-threads
 
 
diff --git a/tests/test-returning-errno/stub-generator/driver.ml b/tests/test-returning-errno/stub-generator/driver.ml
new file mode 100644
index 00000000..567df40f
--- /dev/null
+++ b/tests/test-returning-errno/stub-generator/driver.ml
@@ -0,0 +1,19 @@
+(*
+ * 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 errno tests. *)
+
+let cheader = "#include <stdlib.h>
+#include <errno.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)
+    ~errno:Cstubs.return_errno
diff --git a/tests/test-returning-errno/stubs/functions.ml b/tests/test-returning-errno/stubs/functions.ml
new file mode 100644
index 00000000..4d829b04
--- /dev/null
+++ b/tests/test-returning-errno/stubs/functions.ml
@@ -0,0 +1,19 @@
+(*
+ * Copyright (c) 2016 Jeremy Yallop.
+ *
+ * This file is distributed under the terms of the MIT License.
+ * See the file LICENSE for details.
+ *)
+
+(* Foreign function bindings for the Errno tests. *)
+
+open Ctypes
+
+module Stubs (F: Cstubs.FOREIGN) =
+struct
+  open F
+
+  let struct_stat : [`stat] structure typ = structure "stat"
+  let stat = foreign "stat"
+      (string @-> ptr struct_stat @-> returning int)
+end
diff --git a/tests/test-returning-errno/stubs/types.ml b/tests/test-returning-errno/stubs/types.ml
new file mode 100644
index 00000000..634dcb23
--- /dev/null
+++ b/tests/test-returning-errno/stubs/types.ml
@@ -0,0 +1,23 @@
+(*
+ * Copyright (c) 2016 Jeremy Yallop.
+ *
+ * This file is distributed under the terms of the MIT License.
+ * See the file LICENSE for details.
+ *)
+
+open Ctypes
+open PosixTypes
+
+module Struct_stubs(S : Cstubs.Types.TYPE) =
+struct
+  open S
+
+  let _ENOENT = constant "ENOENT" int
+
+  let ifdir = constant "S_IFDIR" (lift_typ mode_t)
+  let ifmt = constant "S_IFMT" (lift_typ mode_t)
+
+  let stat : [`stat] structure typ = structure "stat"
+  let st_mode = field stat "st_mode" (lift_typ mode_t)
+  let () = seal stat
+end
diff --git a/tests/test-returning-errno/test_returning_errno.ml b/tests/test-returning-errno/test_returning_errno.ml
new file mode 100644
index 00000000..fd94949f
--- /dev/null
+++ b/tests/test-returning-errno/test_returning_errno.ml
@@ -0,0 +1,39 @@
+(*
+ * Copyright (c) 2016 Jeremy Yallop.
+ *
+ * This file is distributed under the terms of the MIT License.
+ * See the file LICENSE for details.
+ *)
+
+open OUnit2
+open Ctypes
+
+
+module Bindings = Functions.Stubs(Generated_bindings)
+module Constants = Types.Struct_stubs(Generated_struct_bindings)
+
+
+(*
+  Test the binding to "stat".
+ *)
+let test_stat _ =
+  let st = make Constants.stat in
+  begin
+    let x, errno = Bindings.stat "." (addr st) in
+    assert_equal 0 x;
+    assert_equal 0 errno;
+
+    let x, errno = Bindings.stat "/does-not-exist" (addr st) in
+    assert_equal (-1) x;
+    assert_equal Constants._ENOENT errno;
+  end
+
+
+let suite = "Errno tests" >:::
+  ["calling stat"
+    >:: test_stat;
+  ]
+
+
+let _ =
+  run_test_tt_main suite

From 89f7ad0d9f1e9fda647b99411c147afc49828b01 Mon Sep 17 00:00:00 2001
From: Jeremy Yallop <yallop@gmail.com>
Date: Thu, 26 May 2016 11:12:06 +0100
Subject: [PATCH 09/11] Add a function for pairing a value with 'errno' to
 ctypes_cstubs_internals_h.

---
 src/ctypes/ctypes_cstubs_internals.h | 13 +++++++++++++
 1 file changed, 13 insertions(+)

diff --git a/src/ctypes/ctypes_cstubs_internals.h b/src/ctypes/ctypes_cstubs_internals.h
index f7176e65..9b623a89 100644
--- a/src/ctypes/ctypes_cstubs_internals.h
+++ b/src/ctypes/ctypes_cstubs_internals.h
@@ -19,5 +19,18 @@
   (String_val(Field(s, 1)) + Int_val(Field(s, 0)))
 #define Ctypes_val_char(c) \
   (Val_int((c + 256) % 256))
+#define CTYPES_PAIR_WITH_ERRNO(v)
+
+#include <caml/memory.h>
+#include <errno.h>
+static inline value ctypes_pair_with_errno(value p)
+{
+  CAMLparam1 (p);
+  CAMLlocal1 (v);
+  v = caml_alloc_tuple(2);
+  Store_field (v, 0, p);
+  Store_field (v, 1, Val_int(errno));
+  CAMLreturn (v);
+}
 
 #endif /* CTYPES_CSTUBS_INTERNALS_H */

From 496dce9d49a46f4f68eaed6da88d622128a1d592 Mon Sep 17 00:00:00 2001
From: Jeremy Yallop <yallop@gmail.com>
Date: Thu, 26 May 2016 12:22:04 +0100
Subject: [PATCH 10/11] C code generation: allow assignment to globals.

---
 src/cstubs/cstubs_c_language.ml | 2 +-
 src/cstubs/cstubs_emit_c.ml     | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/cstubs/cstubs_c_language.ml b/src/cstubs/cstubs_c_language.ml
index 287addf5..cda77817 100644
--- a/src/cstubs/cstubs_c_language.ml
+++ b/src/cstubs/cstubs_c_language.ml
@@ -41,7 +41,7 @@ type cexp = [ cconst
             | clocal
             | `Cast of ty * cexp
             | `Addr of cvar ]
-type clvalue = [ clocal
+type clvalue = [ cvar
                | `Index of clvalue * cexp
                | `Field of clvalue * fieldname 
                | `PointerField of clvalue * fieldname ]
diff --git a/src/cstubs/cstubs_emit_c.ml b/src/cstubs/cstubs_emit_c.ml
index a05b32fc..b85907ca 100644
--- a/src/cstubs/cstubs_emit_c.ml
+++ b/src/cstubs/cstubs_emit_c.ml
@@ -48,7 +48,7 @@ let rec cexp fmt : cexp -> unit = function
   | `Addr (`Local (name, _)) -> fprintf fmt "@[&@[%s@]@]" name
 
 let rec clvalue fmt : clvalue -> unit = function
-  | `Local _ as x -> cvar fmt x
+  | #cvar as x -> cvar fmt x
   | `Index (lv, i) ->
     fprintf fmt "@[@[%a@]@[[%a]@]@]" clvalue lv cexp i
   | `Field (lv, f) ->

From d883ab2394eefa7b2db1c4bbbe16e0963c89e436 Mon Sep 17 00:00:00 2001
From: Jeremy Yallop <yallop@gmail.com>
Date: Thu, 26 May 2016 11:33:46 +0100
Subject: [PATCH 11/11] C code generation for synchronous (non-Lwt) functions
 that return errno.

---
 src/cstubs/cstubs_generate_c.ml | 37 +++++++++++++++++++++++----------
 1 file changed, 26 insertions(+), 11 deletions(-)

diff --git a/src/cstubs/cstubs_generate_c.ml b/src/cstubs/cstubs_generate_c.ml
index 5415381d..877079b3 100644
--- a/src/cstubs/cstubs_generate_c.ml
+++ b/src/cstubs/cstubs_generate_c.ml
@@ -13,6 +13,8 @@ open Unchecked_function_types
 
 let max_byte_args = 5
 
+type errno_policy = [ `Ignore_errno | `Return_errno ]
+
 module Generate_C =
 struct
   let report_unpassable what =
@@ -62,6 +64,11 @@ struct
                           (value @-> returning (ptr void)),
                    [x])
 
+  let pair_with_errno : cexp -> ceff =
+    fun x -> `App (conser "ctypes_pair_with_errno"
+                     (value @-> returning value),
+                   [x])
+
   let string_to_ptr : cexp -> ccomp =
     fun x -> `App (reader "CTYPES_PTR_OF_OCAML_STRING"
                           (value @-> returning (ptr void)),
@@ -87,9 +94,9 @@ struct
                                   references_ocaml_heap = true;
                                   typ = Ty value }
 
-  let errno : ceff = `Global { name = "errno";
-                               references_ocaml_heap = false;
-                               typ = Ty int }
+  let errno = `Global { name = "errno";
+                        references_ocaml_heap = false;
+                        typ = Ty int }
 
   let functions : ceff = `Global
     { name = "functions";
@@ -167,8 +174,9 @@ struct
   let fundec : type a. string -> a Ctypes.fn -> cfundec =
     fun name fn -> `Fundec (name, args fn, return_type fn)
 
-  let fn : type a. cname:string -> stub_name:string -> a Ctypes_static.fn -> cfundef =
-    fun ~cname ~stub_name f ->
+  let fn : type a. errno:errno_policy ->
+    cname:string -> stub_name:string -> a Ctypes_static.fn -> cfundef =
+    fun ~errno:errno_ ~cname ~stub_name f ->
       let fvar = { fname = cname;
                    allocates = false;
                    reads_ocaml_heap = false;
@@ -177,9 +185,16 @@ struct
          fun vars -> function
          | Returns t ->
            let x = fresh_var () in
-           let e, ty = `App (fvar, (List.rev vars :> cexp list)), t in
-           let k = fun x -> (inj t x :> ccomp)  in
-           `Let ((local x ty, e), k (local x ty))
+           let e = `App (fvar, (List.rev vars :> cexp list)) in
+           begin match errno_ with
+               `Ignore_errno -> `Let ((local x t, e), (inj t (local x t) :> ccomp))
+             | `Return_errno -> 
+               (`LetAssign (errno,
+                           `Int 0,
+                           `Let ((local x t, e),
+                                 ((inj t (local x t) :> ccomp), value) >>= fun v ->
+                                 (pair_with_errno v :> ccomp))) : ccomp)
+           end
          | Function (x, f, t) ->
            begin match prj f (local x value) with
              None -> body vars t
@@ -282,9 +297,9 @@ struct
 
 end
 
-let fn ~cname ~stub_name fmt fn =
+let fn ~errno ~cname ~stub_name fmt fn =
   let `Function (`Fundec (f, xs, _), _, _) as dec
-      = Generate_C.fn ~stub_name ~cname fn
+      = Generate_C.fn ~errno ~stub_name ~cname fn
   in
   let nargs = List.length xs in
   if nargs > max_byte_args then begin
@@ -454,5 +469,5 @@ struct
 end
 
 let fn ~concurrency ~errno = match concurrency with
-    `Sequential -> fn
+    `Sequential -> fn ~errno
   | `Lwt_jobs -> Lwt.fn ~errno