From 7373ea1185a66f9e2e0dfa5d4b395747138953c1 Mon Sep 17 00:00:00 2001 From: Jeremy Yallop Date: Wed, 4 Dec 2019 15:00:57 +0000 Subject: [PATCH 1/2] Documentation and layout tweaks. --- src/ctypes-foreign-base/ctypes_ffi.ml | 4 +- src/ctypes-foreign-base/ctypes_ffi.mli | 5 +- src/ctypes-foreign-threaded/foreign.mli | 83 ++++++++++++----------- src/ctypes-foreign-unthreaded/foreign.mli | 81 +++++++++++----------- tests/clib/test_functions.c | 8 +-- tests/test-funptrs/stubs/functions.ml | 22 +++--- tests/test-funptrs/test_funptrs.ml | 6 +- 7 files changed, 114 insertions(+), 95 deletions(-) diff --git a/src/ctypes-foreign-base/ctypes_ffi.ml b/src/ctypes-foreign-base/ctypes_ffi.ml index 416f984b..3a1d7e04 100644 --- a/src/ctypes-foreign-base/ctypes_ffi.ml +++ b/src/ctypes-foreign-base/ctypes_ffi.ml @@ -269,9 +269,9 @@ struct "WARN: a ctypes function pointer was not explicitly released.\n\ Releasing a function pointer or the associated OCaml closure while \n\ the function pointer is still in use from C will cause segmentation faults.\n\ - Please call [Foreign.free_funptr] explicitly when the funptr is no longer needed.\n\ + Please call [Foreign.Funptr.free] explicitly when the funptr is no longer needed.\n\ To avoid a segmentation fault we are preventing this funptr from\n\ - being garbage collected. Please use [Foreign.free_funptr].\n%!")) t; + being garbage collected. Please use [Foreign.Funptr.free].\n%!")) t; t let funptr_of_fun ~abi ~acquire_runtime_lock ~thread_registration fn = diff --git a/src/ctypes-foreign-base/ctypes_ffi.mli b/src/ctypes-foreign-base/ctypes_ffi.mli index aa0cad95..c57ee07f 100644 --- a/src/ctypes-foreign-base/ctypes_ffi.mli +++ b/src/ctypes-foreign-base/ctypes_ffi.mli @@ -42,8 +42,9 @@ sig val free_funptr : _ funptr -> unit - val funptr_of_fun : abi:abi -> acquire_runtime_lock:bool -> thread_registration:bool - -> ('a -> 'b) fn -> ('a -> 'b) -> ('a -> 'b) funptr + val funptr_of_fun : abi:abi -> acquire_runtime_lock:bool -> + thread_registration:bool -> + ('a -> 'b) fn -> ('a -> 'b) -> ('a -> 'b) funptr val funptr_of_static_funptr : ('a -> 'b) static_funptr -> ('a -> 'b) funptr diff --git a/src/ctypes-foreign-threaded/foreign.mli b/src/ctypes-foreign-threaded/foreign.mli index 91749aaf..6200860a 100644 --- a/src/ctypes-foreign-threaded/foreign.mli +++ b/src/ctypes-foreign-threaded/foreign.mli @@ -56,14 +56,6 @@ val funptr : ('a -> 'b) Ctypes.typ (** Construct a function pointer type from a function type. - ---- - - This function ties the lifetime of the C funtion to the associated OCaml closure. - - An alternative with explicity lifetime management is {!dynamic_funptr} - - ---- - The ctypes library, like C itself, distinguishes functions and function pointers. Functions are not first class: it is not possible to use them as arguments or return values of calls, or store them in addressable @@ -83,7 +75,15 @@ val funptr : should be acquired and held during the call. @raise Dl.DL_error if [name] is not found in [?from] and [?stub] is - [false]. *) + [false]. + + A note on lifetime: this function ties the lifetime of the C function to + the associated OCaml closure, so that the C function may be used only + while the closure is still live. + + The {!dynamic_funptr} function is an alternative to {funptr} with explicit + lifetime management. + *) val funptr_opt : ?abi:Libffi_abi.abi -> @@ -107,13 +107,16 @@ module type Funptr = sig (** [fn] is the signature of the underlying OCaml function. *) type t - (** Handle to an OCaml function that can be passed to C for use in callbacks. + (** Handle to an OCaml function that can be passed to C for use in + callbacks. - Each value of type {!t} allocated by {!of_fun} must be deallocated by calling {!free}. - Alternatively {!with_fun} encapsulates both allocation and deallocation. *) + Each value of type {!t} allocated by {!of_fun} must be deallocated by + calling {!free}. Alternatively {!with_fun} encapsulates both allocation + and deallocation. *) val t : t Ctypes.typ - (** A type representation for a function pointer type with explicit lifetime management. *) + (** A type representation for a function pointer type with explicit lifetime + management. *) val t_opt : t option Ctypes.typ (** This behaves like {!t}, except that null pointers appear in OCaml as [None]. *) @@ -121,33 +124,31 @@ module type Funptr = sig val free : t -> unit (** Indicate that the [fptr] is no longer needed. - Once [free] has been called any C calls to this [Funptr.t] are + Once [free] has been called any C calls to this [Dynamic_funptr.t] are unsafe. Only call [free] once the callback is no longer used from C. *) val of_fun : fn -> t (** Turn an OCaml closure into a function pointer that can be passed to C. - You MUST call {!free} when the function pointer is no longer needed. - Failure to do so will result in a memory leak. + The function pointer returned by [of_fun] should be deallocated by a + call to {!free} once it is no longer in use. Failure to call {!free} is + an error. - Failure to call {!free} and not holding a reference this this pointer - is an error. + Alternatively, {!with_fun} encapsulates both allocation and + deallocation. - Alternatively {!with_fun} encapsulates both allocation and deallocation. - - Implementation detail: To avoid hard to debug crashes the implementation - will leak the OCaml closure in this event that {!free} was not used and - report a warning, see {!on_leaked_funptr}. *) + Implementation detail: to avoid crashes, if {!free} is not called then + the implementation will retain a reference to the OCaml closure and + report a warning. See {!report_leaked_funptr}. *) val with_fun : fn -> (t -> 'c) -> 'c - (** [with_fun fn (fun fptr -> DO_STUFF)] - Turn an OCaml closure into a - function pointer and do simple life cycle management. +(** [with_fun fn (fun fptr -> e)] - Turn an OCaml closure into a function + pointer and perform simple life cycle management. - This will automatically call [free fptr] after [DO_STUFF] completes. + [with_fun fn (fun fptr -> e)] will call [free fptr] after [e] completes. - [with_fun] is not safe to use if the C function ptr [fptr] may still be used - after [DO_STUFF] completes. - *) + [with_fun] is not safe to use if the C function ptr [fptr] may still be + used after [e] completes. *) end val dynamic_funptr @@ -156,16 +157,18 @@ val dynamic_funptr -> ?thread_registration:bool -> ('a -> 'b) Ctypes.fn -> (module Funptr with type fn = 'a->'b) -(** Define a type representation for more safely passing OCaml functions to C. +(** Define a type representation for passing OCaml functions to C with + explicit lifetime management. - [(val (dynamic_funptr (FOO @-> returning BAR)))] is roughly equivalent to - [BAR( * )(FOO)] in C. + [(val (dynamic_funptr (foo @-> returning bar)))] corresponds to + the C type [bar( * )(foo)]. Example: {[ - module Progress_callback = (val (dynamic_funptr (int @-> int @-> ptr void @-> returning void))) - let keygen = - foreign "RSA_generate_key" (int @-> int @-> Progress_callback.t @-> ptr void @-> returning rsa_key) + module Progress_callback = + (val (dynamic_funptr (int @-> int @-> ptr void @-> returning void))) + let keygen = foreign "RSA_generate_key" + (int @-> int @-> Progress_callback.t @-> ptr void @-> returning rsa_key) let secret_key = Progress_callback.with_fun (fun a b _ -> printf "progress: a:%d, b:%d\n" a b) @@ -175,9 +178,11 @@ val dynamic_funptr *) val report_leaked_funptr : (string -> unit) ref -(** Hook for setting custom handling for leaked non-{!free}d {!dynamic_funptr}s. +(** Hook called on collection of closures associated with + {!dynamic_funptr} values that have not been deallocated with {!free}. - By default the library will retain function pointers that have not been freed and - print an warning to stderr. + By default the ctypes library retains closures associated with function + pointers that have not been freed and prints a warning to stderr. - You can use this hook to change how these error messages are reported. *) + You can use this hook to change how these error messages are reported. + *) diff --git a/src/ctypes-foreign-unthreaded/foreign.mli b/src/ctypes-foreign-unthreaded/foreign.mli index 8f3a7996..6200860a 100644 --- a/src/ctypes-foreign-unthreaded/foreign.mli +++ b/src/ctypes-foreign-unthreaded/foreign.mli @@ -56,14 +56,6 @@ val funptr : ('a -> 'b) Ctypes.typ (** Construct a function pointer type from a function type. - ---- - - This function ties the lifetime of the C funtion to the associated OCaml closure. - - An alternative with explicity lifetime management is {!dynamic_funptr} - - ---- - The ctypes library, like C itself, distinguishes functions and function pointers. Functions are not first class: it is not possible to use them as arguments or return values of calls, or store them in addressable @@ -83,7 +75,15 @@ val funptr : should be acquired and held during the call. @raise Dl.DL_error if [name] is not found in [?from] and [?stub] is - [false]. *) + [false]. + + A note on lifetime: this function ties the lifetime of the C function to + the associated OCaml closure, so that the C function may be used only + while the closure is still live. + + The {!dynamic_funptr} function is an alternative to {funptr} with explicit + lifetime management. + *) val funptr_opt : ?abi:Libffi_abi.abi -> @@ -107,13 +107,16 @@ module type Funptr = sig (** [fn] is the signature of the underlying OCaml function. *) type t - (** Handle to an OCaml function that can be passed to C for use in callbacks. + (** Handle to an OCaml function that can be passed to C for use in + callbacks. - Each value of type {!t} allocated by {!of_fun} must be deallocated by calling {!free}. - Alternatively {!with_fun} encapsulates both allocation and deallocation. *) + Each value of type {!t} allocated by {!of_fun} must be deallocated by + calling {!free}. Alternatively {!with_fun} encapsulates both allocation + and deallocation. *) val t : t Ctypes.typ - (** A type representation for a function pointer type with explicit lifetime management. *) + (** A type representation for a function pointer type with explicit lifetime + management. *) val t_opt : t option Ctypes.typ (** This behaves like {!t}, except that null pointers appear in OCaml as [None]. *) @@ -127,27 +130,25 @@ module type Funptr = sig val of_fun : fn -> t (** Turn an OCaml closure into a function pointer that can be passed to C. - You MUST call {!free} when the function pointer is no longer needed. - Failure to do so will result in a memory leak. + The function pointer returned by [of_fun] should be deallocated by a + call to {!free} once it is no longer in use. Failure to call {!free} is + an error. - Failure to call {!free} and not holding a reference this this pointer - is an error. + Alternatively, {!with_fun} encapsulates both allocation and + deallocation. - Alternatively {!with_fun} encapsulates both allocation and deallocation. - - Implementation detail: To avoid hard to debug crashes the implementation - will leak the OCaml closure in this event that {!free} was not used and - report a warning, see {!on_leaked_funptr}. *) + Implementation detail: to avoid crashes, if {!free} is not called then + the implementation will retain a reference to the OCaml closure and + report a warning. See {!report_leaked_funptr}. *) val with_fun : fn -> (t -> 'c) -> 'c - (** [with_fun fn (fun fptr -> DO_STUFF)] - Turn an OCaml closure into a - function pointer and do simple life cycle management. +(** [with_fun fn (fun fptr -> e)] - Turn an OCaml closure into a function + pointer and perform simple life cycle management. - This will automatically call [free fptr] after [DO_STUFF] completes. + [with_fun fn (fun fptr -> e)] will call [free fptr] after [e] completes. - [with_fun] is not safe to use if the C function ptr [fptr] may still be used - after [DO_STUFF] completes. - *) + [with_fun] is not safe to use if the C function ptr [fptr] may still be + used after [e] completes. *) end val dynamic_funptr @@ -156,16 +157,18 @@ val dynamic_funptr -> ?thread_registration:bool -> ('a -> 'b) Ctypes.fn -> (module Funptr with type fn = 'a->'b) -(** Define a type representation for more safely passing OCaml functions to C. +(** Define a type representation for passing OCaml functions to C with + explicit lifetime management. - [(val (dynamic_funptr (FOO @-> returning BAR)))] is roughly equivalent to - [BAR( * )(FOO)] in C. + [(val (dynamic_funptr (foo @-> returning bar)))] corresponds to + the C type [bar( * )(foo)]. Example: {[ - module Progress_callback = (val (dynamic_funptr (int @-> int @-> ptr void @-> returning void))) - let keygen = - foreign "RSA_generate_key" (int @-> int @-> Progress_callback.t @-> ptr void @-> returning rsa_key) + module Progress_callback = + (val (dynamic_funptr (int @-> int @-> ptr void @-> returning void))) + let keygen = foreign "RSA_generate_key" + (int @-> int @-> Progress_callback.t @-> ptr void @-> returning rsa_key) let secret_key = Progress_callback.with_fun (fun a b _ -> printf "progress: a:%d, b:%d\n" a b) @@ -175,9 +178,11 @@ val dynamic_funptr *) val report_leaked_funptr : (string -> unit) ref -(** Hook for setting custom handling for leaked non-{!free}d {!dynamic_funptr}s. +(** Hook called on collection of closures associated with + {!dynamic_funptr} values that have not been deallocated with {!free}. - By default the library will retain function pointers that have not been freed and - print an warning to stderr. + By default the ctypes library retains closures associated with function + pointers that have not been freed and prints a warning to stderr. - You can use this hook to change how these error messages are reported. *) + You can use this hook to change how these error messages are reported. + *) diff --git a/tests/clib/test_functions.c b/tests/clib/test_functions.c index a74a913c..2ab0ef4d 100644 --- a/tests/clib/test_functions.c +++ b/tests/clib/test_functions.c @@ -894,8 +894,8 @@ int foreign_thread_registration_test(void (*test_f)(uint64_t), return ret_code; } -int call_dynamic_funptr(int (*f)(int),int n) { - if(f == NULL) return 0; +int call_dynamic_funptr(int (*f)(int), int n) { + if (f == NULL) return 0; else return f(n); } @@ -909,5 +909,5 @@ int call_saved_dynamic_funptr(int n) { return call_dynamic_funptr(saved_dynamic_funptr, n); } -int call_dynamic_funptr_struct(struct simple_closure x) { return (x.f(x.n)); } -int call_dynamic_funptr_struct_ptr(struct simple_closure *x) { return (x->f(x->n)); } +int call_dynamic_funptr_struct(struct simple_closure x) { return x.f(x.n); } +int call_dynamic_funptr_struct_ptr(struct simple_closure *x) { return x->f(x->n); } diff --git a/tests/test-funptrs/stubs/functions.ml b/tests/test-funptrs/stubs/functions.ml index acacbd8a..9fd84707 100644 --- a/tests/test-funptrs/stubs/functions.ml +++ b/tests/test-funptrs/stubs/functions.ml @@ -6,12 +6,16 @@ module Stubs (F: Ctypes.FOREIGN) = struct open F - let call_dynamic_funptr = foreign "call_dynamic_funptr" (Callback.t @-> int @-> returning int) - let save_dynamic_funptr = foreign "save_dynamic_funptr" (Callback.t @-> returning void) - let call_saved_dynamic_funptr = foreign "call_saved_dynamic_funptr" (int @-> returning int) - - let call_dynamic_funptr_opt = foreign "call_dynamic_funptr" (Callback.t_opt @-> int @-> returning int) - let save_dynamic_funptr_opt = foreign "save_dynamic_funptr" (Callback.t_opt @-> returning void) + let call_dynamic_funptr = foreign "call_dynamic_funptr" + (Callback.t @-> int @-> returning int) + let save_dynamic_funptr = foreign "save_dynamic_funptr" + (Callback.t @-> returning void) + let call_saved_dynamic_funptr = foreign "call_saved_dynamic_funptr" + (int @-> returning int) + let call_dynamic_funptr_opt = foreign "call_dynamic_funptr" + (Callback.t_opt @-> int @-> returning int) + let save_dynamic_funptr_opt = foreign "save_dynamic_funptr" + (Callback.t_opt @-> returning void) type simple_closure let simple_closure : simple_closure structure typ = structure "simple_closure" @@ -19,6 +23,8 @@ struct let simple_closure_n = field simple_closure "n" int let () = seal simple_closure - let call_dynamic_funptr_struct = foreign "call_dynamic_funptr_struct" (simple_closure @-> returning int) - let call_dynamic_funptr_struct_ptr = foreign "call_dynamic_funptr_struct_ptr" (ptr simple_closure @-> returning int) + let call_dynamic_funptr_struct = foreign "call_dynamic_funptr_struct" + (simple_closure @-> returning int) + let call_dynamic_funptr_struct_ptr = foreign "call_dynamic_funptr_struct_ptr" + (ptr simple_closure @-> returning int) end diff --git a/tests/test-funptrs/test_funptrs.ml b/tests/test-funptrs/test_funptrs.ml index 3335b7f6..de1d126c 100644 --- a/tests/test-funptrs/test_funptrs.ml +++ b/tests/test-funptrs/test_funptrs.ml @@ -72,7 +72,8 @@ struct detect_funptr_leaks (fun () -> let assert_closure = let f, assert_closure = make_f () in - assert_equal 3 (Callback.with_fun f (fun f -> M.call_dynamic_funptr f 2)); + assert_equal 3 (Callback.with_fun f + (fun f -> M.call_dynamic_funptr f 2)); assert_closure in assert_closure `Released) @@ -85,7 +86,8 @@ struct let test_opt_some _ = detect_funptr_leaks (fun () -> - assert_equal 3 (Callback.with_fun ((+) 1) (fun f -> M.call_dynamic_funptr_opt (Some f) 2))) + assert_equal 3 (Callback.with_fun ((+) 1) + (fun f -> M.call_dynamic_funptr_opt (Some f) 2))) ;; let test_save_and_free _ = From a928781fb235f3ec09535b7910450f1d45e9b805 Mon Sep 17 00:00:00 2001 From: Jeremy Yallop Date: Wed, 4 Dec 2019 15:13:09 +0000 Subject: [PATCH 2/2] Changes for OCaml 4.02 compatibility: * use 'fun (type a) (type b) ...' instead of 'fun (type a b)' * use Gc.finalise instead of Gc.finalise_last --- src/ctypes-foreign-base/ctypes_foreign_basis.ml | 7 +++++-- tests/test-funptrs/test_funptrs.ml | 2 +- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/src/ctypes-foreign-base/ctypes_foreign_basis.ml b/src/ctypes-foreign-base/ctypes_foreign_basis.ml index 600e8643..bfc9de95 100644 --- a/src/ctypes-foreign-base/ctypes_foreign_basis.ml +++ b/src/ctypes-foreign-base/ctypes_foreign_basis.ml @@ -58,7 +58,9 @@ struct val with_fun : fn -> (t -> 'c) -> 'c end - let dynamic_funptr (type a b) ?(abi=Libffi_abi.default_abi) ?(runtime_lock=false) ?(thread_registration=false) fn : (module Funptr with type fn = a -> b) = + let dynamic_funptr (type a) (type b) ?(abi=Libffi_abi.default_abi) + ?(runtime_lock=false) ?(thread_registration=false) fn + : (module Funptr with type fn = a -> b) = (module struct type fn = a -> b type t = fn Ffi.funptr @@ -70,7 +72,8 @@ struct let t_opt = Ctypes_std_views.nullable_funptr_view t fn let free = Ffi.free_funptr - let of_fun = Ffi.funptr_of_fun ~abi ~acquire_runtime_lock:runtime_lock ~thread_registration fn + let of_fun = Ffi.funptr_of_fun ~abi ~acquire_runtime_lock:runtime_lock + ~thread_registration fn let with_fun f do_it = let f = of_fun f in diff --git a/tests/test-funptrs/test_funptrs.ml b/tests/test-funptrs/test_funptrs.ml index de1d126c..aed7b632 100644 --- a/tests/test-funptrs/test_funptrs.ml +++ b/tests/test-funptrs/test_funptrs.ml @@ -35,7 +35,7 @@ struct let make_f () : (int -> int) * ([`Live|`Released] -> unit) = let closure_status = ref `Live in let f = (+) 1 in - Gc.finalise_last (fun () -> closure_status := `Released) f; + Gc.finalise (fun _ -> closure_status := `Released) f; f, (fun status -> Gc.full_major (); Gc.full_major ();