tests/ffi/: De-register callback. Document asserts.

diff --git a/tests/ffi/test-ffi-wrapper.scm b/tests/ffi/test-ffi-wrapper.scm
index 6450ccf766b7bd9d1cda39d6d47e70a18342e8fb..b600b9ff51cc94c6d2af1c6f0dca99b936fbc5b2 100644 (file)
--- a/tests/ffi/test-ffi-wrapper.scm
+++ b/tests/ffi/test-ffi-wrapper.scm
@@ -7,7 +7,8 @@
         (string "input string")
         (pi (* 4 (atan 1 1)))
         (chars (malloc (1+ (* (c-sizeof "char") (string-length string)))
-                       '(* char))))
+                       '(* char)))
+        (callback-id (C-callback (lambda (d) (* d pi)))))
     (C->= struct "TestStruct first" (char->ascii #\A))
     (C->= struct "TestStruct second" pi)
     (C->= struct "TestStruct third" (char->ascii #\C))
@@ -15,16 +16,22 @@
     (C->= struct "TestStruct fourth" chars)
     (C-call "test_register_double"
            (C-callback "test_double_callback")
-           (C-callback (lambda (d) (* d pi))))
-    (list
-     (let ((d (C-call "test_double" pi struct)))
-       (assert-equal (* pi pi pi) d))
-     (assert-equal (number->string (* 2 (string-length string)))
-                  (let* ((alien (make-alien-to-free
-                                 '(* char)
-                                 (lambda (retval)
-                                   (C-call "test_string" retval
-                                           string struct))))
-                         (new (c-peek-cstring alien)))
-                    (free alien)
-                    new)))))
\ No newline at end of file
+           callback-id)
+    (let ((d (C-call "test_double" pi struct)))
+      (assert-equal (* pi pi pi) d))
+    (de-register-c-callback callback-id)
+    (assert-equal (number->string (* 2 (string-length string)))
+                 (let* ((alien (make-alien-to-free
+                                '(* char)
+                                (lambda (retval)
+                                  (C-call "test_string" retval
+                                          string struct))))
+                        (new (c-peek-cstring alien)))
+                   (free alien)
+                   new))
+    (let ((ffi (->environment '(runtime ffi))))
+      (gc-flip)
+      (assert-= (car ((access registered-callback-count ffi)))
+               0 'EXPRESSION '(REGISTERED-CALLBACK-COUNT))
+      (assert-= (length (access malloced-aliens ffi))
+               0 'EXPRESSION '(LENGTH MALLOCED-ALIENS)))))
\ No newline at end of file