From 55a2f9aacc234a76254b77f0e145a1f7598b9093 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Thu, 12 Jul 2012 14:55:38 -0700 Subject: [PATCH] tests/ffi/: De-register callback. Document asserts. --- tests/ffi/test-ffi-wrapper.scm | 35 ++++++++++++++++++++-------------- 1 file changed, 21 insertions(+), 14 deletions(-) diff --git a/tests/ffi/test-ffi-wrapper.scm b/tests/ffi/test-ffi-wrapper.scm index 6450ccf76..b600b9ff5 100644 --- 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 -- 2.25.1