From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Thu, 12 Jul 2012 21:55:38 +0000 (-0700)
Subject: tests/ffi/: De-register callback.  Document asserts.
X-Git-Tag: release-9.2.0~239
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=55a2f9aacc234a76254b77f0e145a1f7598b9093;p=mit-scheme.git

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

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