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 <st...@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

_______________________________________________
Pkg-ocaml-maint-commits mailing list
Pkg-ocaml-maint-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-ocaml-maint-commits

Reply via email to