From: Taylor R Campbell <campbell@mumble.net>
Date: Fri, 20 Aug 2010 02:57:36 +0000 (+0000)
Subject: Add tests for ephemerons with compiled entries for keys and data.
X-Git-Tag: 20101212-Gtk~88
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=dd5cf07aedcc45faaa22b6bbca73cd06f0c8459b;p=mit-scheme.git

Add tests for ephemerons with compiled entries for keys and data.
---

diff --git a/tests/runtime/test-ephemeron.scm b/tests/runtime/test-ephemeron.scm
index dcd7cb42a..787ea136b 100644
--- a/tests/runtime/test-ephemeron.scm
+++ b/tests/runtime/test-ephemeron.scm
@@ -409,3 +409,45 @@ USA.
 	  (assert-true (ephemeron? ephemeron))
 	  (assert-broken ephemeron))))))
 |#
+
+;;; Assumption: CONSTANT-PROCEDURE yields compiled closures.
+
+(define-test 'COMPILED-KEY
+  (lambda ()
+    (let ((key (constant-procedure 0)) (datum (list 'DATUM)))
+      (let ((e (make-ephemeron key datum)))
+	(repeat (lambda ()
+		  (assert-true (procedure? (ephemeron-key e)))
+		  (assert-eqv ((ephemeron-key e)) 0)
+		  (assert-equal (ephemeron-datum e) '(DATUM))
+		  (assert-false (ephemeron-broken? e))))
+	(reference-barrier key)
+	(set! key 0)
+	(finally (lambda () (assert-broken e)))))))
+
+(define-test 'COMPILED-DATUM
+  (lambda ()
+    (let ((key (list 'KEY)) (datum (constant-procedure 0)))
+      (let ((e (make-ephemeron key datum)))
+	(repeat (lambda ()
+		  (assert-equal (ephemeron-key e) '(KEY))
+		  (assert-true (procedure? (ephemeron-datum e)))
+		  (assert-eqv ((ephemeron-datum e)) 0)
+		  (assert-false (ephemeron-broken? e))))
+	(reference-barrier key)
+	(set! key 0)
+	(finally (lambda () (assert-broken e)))))))
+
+(define-test 'COMPILED-KEY&DATUM
+  (lambda ()
+    (let ((key (constant-procedure 0)) (datum (constant-procedure 1)))
+      (let ((e (make-ephemeron key datum)))
+	(repeat (lambda ()
+		  (assert-true (procedure? (ephemeron-key e)))
+		  (assert-true (procedure? (ephemeron-datum e)))
+		  (assert-eqv ((ephemeron-key e)) 0)
+		  (assert-eqv ((ephemeron-datum e)) 1)
+		  (assert-false (ephemeron-broken? e))))
+	(reference-barrier key)
+	(set! key 0)
+	(finally (lambda () (assert-broken e)))))))