[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.3-39-g59a0273

[Ludovic Courtès]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=59a0273338ca52dd920eef90439f95d313214a6b

The branch, stable-2.0 has been updated
       via  59a0273338ca52dd920eef90439f95d313214a6b (commit)
      from  4855c63441c5f11a58b8157c877e5890a7b0ffe1 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 59a0273338ca52dd920eef90439f95d313214a6b
Author: Ludovic Courtès <address@hidden>
Date:   Sat Nov 26 22:27:32 2011 +0100

    FFI: Hold a weak reference to the procedure passed to `procedure->pointer'.
    
    * libguile/foreign.c (scm_procedure_to_pointer): Keep a weak reference
      to PROC.
    
    * test-suite/tests/foreign.test ("procedure->pointer")["procedure is
      retained"]: New test.

-----------------------------------------------------------------------

Summary of changes:
 libguile/foreign.c            |    6 ++++--
 test-suite/tests/foreign.test |   16 ++++++++++++++++
 2 files changed, 20 insertions(+), 2 deletions(-)

diff --git a/libguile/foreign.c b/libguile/foreign.c
index 021c183..f3af157 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -1152,7 +1152,8 @@ SCM_DEFINE (scm_procedure_to_pointer, 
"procedure->pointer", 3, 0, 0,
   if (closure == executable)
     {
       pointer = scm_from_pointer (executable, ffi_closure_free);
-      register_weak_reference (pointer, cif_pointer);
+      register_weak_reference (pointer,
+                              scm_list_2 (proc, cif_pointer));
     }
   else
     {
@@ -1166,7 +1167,8 @@ SCM_DEFINE (scm_procedure_to_pointer, 
"procedure->pointer", 3, 0, 0,
       pointer = scm_from_pointer (executable, NULL);
       friend = scm_from_pointer (closure, ffi_closure_free);
 
-      register_weak_reference (pointer, scm_list_2 (cif_pointer, friend));
+      register_weak_reference (pointer,
+                              scm_list_3 (proc, cif_pointer, friend));
     }
 
   return pointer;
diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test
index 5657977..2c326c9 100644
--- a/test-suite/tests/foreign.test
+++ b/test-suite/tests/foreign.test
@@ -272,6 +272,22 @@
                (proc*   (pointer->procedure void pointer '())))
           (proc*)
           called?)
+        (throw 'unresolved)))
+
+  (pass-if "procedure is retained"
+    ;; The lambda passed to `procedure->pointer' must remain live.
+    (if (defined? 'procedure->pointer)
+        (let* ((ptr   (procedure->pointer int
+                                          (lambda (x) (+ x 7))
+                                          (list int)))
+               (procs (unfold (cut >= <> 10000)
+                              (lambda (i)
+                                (pointer->procedure int ptr (list int)))
+                              1+
+                              0)))
+          (gc) (gc) (gc)
+          (every (cut = <> 9)
+                 (map (lambda (f) (f 2)) procs)))
         (throw 'unresolved))))
 
 


hooks/post-receive
-- 
GNU Guile