[Pkg-ocaml-maint-commits] [ocaml-ctypes] 03/12: Imported Upstream version 0.5.1
Stéphane Glondu
glondu at moszumanska.debian.org
Tue Jun 14 09:46:35 UTC 2016
This is an automated email from the git hooks/post-receive script.
glondu pushed a commit to branch master
in repository ocaml-ctypes.
commit ed98921e5f084a5ea9bcd744c18c8eb5932b743c
Author: Stephane Glondu <steph at glondu.net>
Date: Tue Jun 14 11:23:49 2016 +0200
Imported Upstream version 0.5.1
---
CHANGES.md | 6 ++++++
META | 14 +++++++-------
src/ctypes-foreign-base/ctypes_ffi.ml | 2 +-
src/ctypes/ctypes_bigarray.ml | 2 +-
src/ctypes/ctypes_memory_stubs.ml | 4 ++++
src/ctypes/ctypes_roots.c | 6 ++++++
tests/test-bigarrays/test_bigarrays.ml | 16 ++++++++--------
tests/test-callback_lifetime/test_callback_lifetime.ml | 16 ++++++++--------
tests/test-finalisers/test_finalisers.ml | 8 ++++----
tests/test-structs/test_structs.ml | 4 ++--
tests/test-threads/test_threads.ml | 4 ++--
11 files changed, 49 insertions(+), 33 deletions(-)
diff --git a/CHANGES.md b/CHANGES.md
index a465351..7db0cab 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,3 +1,9 @@
+## ctypes 0.5.1
+
+### Bug fixes
+
+* Use a C function, not `Pervasives.ignore`, to keep values alive.
+
## ctypes 0.5.0
Thanks to Andreas Hauptmann (@fdopen), David Sheets (@dsheets), Etienne Millon (@emillon), Goswin von Brederlow (@mrvn), Leonid Rozenberg (@rleonid), @orbitz, Max Mouratov (@cakeplus), and Peter Zotov (@whitequark) for contributions to this release.
diff --git a/META b/META
index eaa497c..e8d9e24 100644
--- a/META
+++ b/META
@@ -1,4 +1,4 @@
-version = "0.5.0"
+version = "0.5.1"
description = "Combinators for binding to C libraries without writing any C."
requires = "unix bigarray str bytes"
archive(byte) = "ctypes.cma"
@@ -8,7 +8,7 @@ archive(native, plugin) = "ctypes.cmxs"
exists_if = "ctypes.cma"
package "top" (
- version = "0.5.0"
+ version = "0.5.1"
description = "Toplevel printers for C types"
requires = "ctypes"
archive(byte) = "ctypes-top.cma"
@@ -19,7 +19,7 @@ package "top" (
)
package "stubs" (
- version = "0.5.0"
+ version = "0.5.1"
description = "Stub generation from C types"
requires = "ctypes"
archive(byte) = "cstubs.cma"
@@ -31,13 +31,13 @@ package "stubs" (
)
package "foreign" (
- version = "0.5.0"
+ version = "0.5.1"
description = "Dynamic linking of C functions"
requires(-mt) = "ctypes.foreign.unthreaded"
requires(mt) = "ctypes.foreign.threaded"
package "base" (
- version = "0.5.0"
+ version = "0.5.1"
description = "Dynamic linking of C functions (base package)"
requires = "ctypes"
archive(byte) = "ctypes-foreign-base.cma"
@@ -48,7 +48,7 @@ package "foreign" (
)
package "threaded" (
- version = "0.5.0"
+ version = "0.5.1"
description = "Dynamic linking of C functions (for use in threaded programs)"
requires = "threads ctypes ctypes.foreign.base"
archive(byte) = "ctypes-foreign-threaded.cma"
@@ -59,7 +59,7 @@ package "foreign" (
)
package "unthreaded" (
- version = "0.5.0"
+ version = "0.5.1"
description = "Dynamic linking of C functions (for use in unthreaded programs)"
requires = "ctypes ctypes.foreign.base"
archive(byte) = "ctypes-foreign-unthreaded.cma"
diff --git a/src/ctypes-foreign-base/ctypes_ffi.ml b/src/ctypes-foreign-base/ctypes_ffi.ml
index c9e2df0..cb19160 100644
--- a/src/ctypes-foreign-base/ctypes_ffi.ml
+++ b/src/ctypes-foreign-base/ctypes_ffi.ml
@@ -136,7 +136,7 @@ struct
raise Ctypes_ffi_stubs.CallToExpiredClosure
in
let v = box (Ctypes_weak_ref.make f') in
- let () = Gc.finalise (fun _ -> ignore (f'); ()) v in
+ let () = Gc.finalise (fun _ -> Ctypes_memory_stubs.use_value f') v in
v)
let write_arg : type a. a typ -> offset:int -> idx:int -> a ->
diff --git a/src/ctypes/ctypes_bigarray.ml b/src/ctypes/ctypes_bigarray.ml
index e92846a..a3c6a71 100644
--- a/src/ctypes/ctypes_bigarray.ml
+++ b/src/ctypes/ctypes_bigarray.ml
@@ -145,4 +145,4 @@ let view : type a b. (a, b) t -> _ Ctypes_ptr.Fat.t -> b =
| Dims3 (d1, d2, d3) -> view3 kind [| d1; d2; d3 |] ptr in
match Ctypes_ptr.Fat.managed ptr with
| None -> ba
- | Some src -> Gc.finalise (fun _ -> ignore src; ()) ba; ba
+ | Some src -> Gc.finalise (fun _ -> Ctypes_memory_stubs.use_value src) ba; ba
diff --git a/src/ctypes/ctypes_memory_stubs.ml b/src/ctypes/ctypes_memory_stubs.ml
index 8487e94..8e0da6d 100644
--- a/src/ctypes/ctypes_memory_stubs.ml
+++ b/src/ctypes/ctypes_memory_stubs.ml
@@ -45,3 +45,7 @@ external memcpy : dst:_ Fat.t -> src:_ Fat.t -> size:int -> unit
(* Read a fixed length OCaml string from memory *)
external string_of_array : _ Fat.t -> len:int -> string
= "ctypes_string_of_array"
+
+(* Do nothing, concealing from the optimizer that nothing is being done. *)
+external use_value : 'a -> unit
+ = "ctypes_use"
diff --git a/src/ctypes/ctypes_roots.c b/src/ctypes/ctypes_roots.c
index 2e4b2d7..ba8237e 100644
--- a/src/ctypes/ctypes_roots.c
+++ b/src/ctypes/ctypes_roots.c
@@ -34,3 +34,9 @@ value ctypes_caml_roots_release(value p_)
caml_stat_free(p);
return Val_unit;
}
+
+/* 'a -> unit */
+value ctypes_use(value v)
+{
+ return v;
+}
diff --git a/tests/test-bigarrays/test_bigarrays.ml b/tests/test-bigarrays/test_bigarrays.ml
index f9c6bfe..0e861bd 100644
--- a/tests/test-bigarrays/test_bigarrays.ml
+++ b/tests/test-bigarrays/test_bigarrays.ml
@@ -404,8 +404,8 @@ let test_bigarray_lifetime_with_ctypes_reference _ =
(* The bigarray is out of scope, but the ctypes object is still live, so
the memory shouldn't be reclaimed. *)
begin
- Gc.major ();
- Gc.major ();
+ Gc.full_major ();
+ Gc.full_major ();
assert_equal !state `Not_safe_to_collect;
assert_equal 1 !@pointer;
end
@@ -414,8 +414,8 @@ let test_bigarray_lifetime_with_ctypes_reference _ =
should (or, at least, could) run. *)
begin
state := `Safe_to_collect;
- Gc.major ();
- Gc.major ();
+ Gc.full_major ();
+ Gc.full_major ();
assert_equal !state `Collected
end
@@ -446,8 +446,8 @@ let test_ctypes_memory_lifetime_with_bigarray_reference _ =
(* The ctypes object is out of scope, but the bigarray is still live, so
the memory shouldn't be reclaimed. *)
begin
- Gc.major ();
- Gc.major ();
+ Gc.full_major ();
+ Gc.full_major ();
assert_equal !state `Not_safe_to_collect;
assert_equal ba.{0} 1L;
assert_equal ba.{3} 4L;
@@ -457,8 +457,8 @@ let test_ctypes_memory_lifetime_with_bigarray_reference _ =
should (or, at least, could) run. *)
begin
state := `Safe_to_collect;
- Gc.major ();
- Gc.major ();
+ Gc.full_major ();
+ Gc.full_major ();
assert_equal !state `Collected
end
diff --git a/tests/test-callback_lifetime/test_callback_lifetime.ml b/tests/test-callback_lifetime/test_callback_lifetime.ml
index e91abec..d835d06 100644
--- a/tests/test-callback_lifetime/test_callback_lifetime.ml
+++ b/tests/test-callback_lifetime/test_callback_lifetime.ml
@@ -25,7 +25,7 @@ struct
begin
store_callback double;
- Gc.major ();
+ Gc.full_major ();
assert_equal 10 (invoke_stored_callback 5)
end
@@ -43,11 +43,11 @@ struct
begin
(* The closure should be collected in the next GC *)
- store_callback (closure 2);
+ store_callback (closure (int_of_string "2"));
(* The first GC collects the closure itself, which frees the associated object
to be collected on the next GC. *)
- Gc.major ();
- Gc.major ();
+ Gc.full_major ();
+ Gc.full_major ();
assert_raises CallToExpiredClosure
(fun () -> invoke_stored_callback 5)
end
@@ -106,27 +106,27 @@ struct
(* First, the naive implementation. This should fail, because arg is
collected before ret is called. *)
- let ret = Naive.make ~arg:(closure 3) in
+ let ret = Naive.make ~arg:(closure (int_of_string "3")) in
Gc.full_major ();
assert_raises CallToExpiredClosure
(fun () -> Naive.get ret 5);
(* Now a more careful implementation. This succeeds, because we keep a
reference to arg around with the reference to ret *)
- let ret = Better.make ~arg:(closure 3) in
+ let ret = Better.make ~arg:(closure (int_of_string "3")) in
Gc.full_major ();
assert_equal 15 (Better.get ret 5);
(* However, even with the careful implementation things can go wrong if we
keep a reference to ret beyond the lifetime of the pair. *)
- let ret = Better.get (Better.make ~arg:(closure 3)) in
+ let ret = Better.get (Better.make ~arg:(closure (int_of_string "3"))) in
Gc.full_major ();
assert_raises CallToExpiredClosure
(fun () -> ret 5);
(* The most careful implementation calls ret rather than returning it,
so arg cannot be collected prematurely. *)
- let ret = Careful.get (Careful.make ~arg:(closure 3)) in
+ let ret = Careful.get (Careful.make ~arg:(closure (int_of_string "3"))) in
Gc.full_major ();
assert_equal 15 (ret 5)
end
diff --git a/tests/test-finalisers/test_finalisers.ml b/tests/test-finalisers/test_finalisers.ml
index 4ae5946..1ddfc11 100644
--- a/tests/test-finalisers/test_finalisers.ml
+++ b/tests/test-finalisers/test_finalisers.ml
@@ -29,13 +29,13 @@ let test_array_finaliser _ =
Array.start a
end in
begin
- Gc.major ();
+ Gc.full_major ();
assert_equal ~msg:"The finaliser was not run"
false !finaliser_completed;
assert_equal 1 !@p;
end in
begin
- Gc.major ();
+ Gc.full_major ();
assert_equal ~msg:"The finaliser was run"
true !finaliser_completed;
end
@@ -69,7 +69,7 @@ let test_struct_finaliser _ =
addr s
end in
begin
- Gc.major ();
+ Gc.full_major ();
assert_equal ~msg:"The finaliser was not run"
false !finaliser_completed;
assert_equal 10l !@(from_voidp int32_t (to_voidp p));
@@ -77,7 +77,7 @@ let test_struct_finaliser _ =
let () =
begin
- Gc.major ();
+ Gc.full_major ();
assert_equal ~msg:"The finaliser was run"
true !finaliser_completed;
end
diff --git a/tests/test-structs/test_structs.ml b/tests/test-structs/test_structs.ml
index 12ea323..6ee245c 100644
--- a/tests/test-structs/test_structs.ml
+++ b/tests/test-structs/test_structs.ml
@@ -341,7 +341,7 @@ let test_field_references_not_invalidated _ =
()
) ()
let () = begin
- Gc.major ();
+ Gc.full_major ();
seal s1;
assert_equal ~printer:string_of_int
(sizeof int) (sizeof s1)
@@ -368,7 +368,7 @@ let test_struct_ffi_type_lifetime _ =
in
Foreign.foreign ~from:testlib "return_struct_by_value" t
- let () = Gc.major()
+ let () = Gc.full_major()
let x = f ()
end in ()
diff --git a/tests/test-threads/test_threads.ml b/tests/test-threads/test_threads.ml
index 3893978..1936d5e 100644
--- a/tests/test-threads/test_threads.ml
+++ b/tests/test-threads/test_threads.ml
@@ -30,8 +30,8 @@ let test_release_runtime_lock _ =
*)
let test_acquire_runtime_lock _ =
begin
- let f x y = let _ = Gc.major () in !@x + !@y in
- let t1 = Thread.create Gc.major () in
+ let f x y = let _ = Gc.full_major () in !@x + !@y in
+ let t1 = Thread.create Gc.full_major () in
assert (callback_with_pointers f = 7);
Thread.join t1
end
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-ocaml-maint/packages/ocaml-ctypes.git
More information about the Pkg-ocaml-maint-commits
mailing list