From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 30 May 2010 23:26:32 +0000 (-0700)
Subject: Add membership test.
X-Git-Tag: 20100708-Gtk~48
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=df4ba3590776465ce68212976fb86c3ce020a26d;p=mit-scheme.git

Add membership test.
---

diff --git a/tests/runtime/test-char-set.scm b/tests/runtime/test-char-set.scm
index 9857f5cf5..caf958ceb 100644
--- a/tests/runtime/test-char-set.scm
+++ b/tests/runtime/test-char-set.scm
@@ -72,6 +72,35 @@ USA.
 	      (if (= m 0)
 		  n
 		  (cons n (+ n m 1))))))))))
+
+(define-test 'membership
+  (lambda ()
+    (map (lambda (svl)
+	   (map (lambda (value)
+		  (run-sub-test
+		   (lambda ()
+		     (with-test-properties
+			 (lambda ()
+			   (assert-boolean-=
+			    (char-set-member? (scalar-values->char-set svl)
+					      (integer->char value))
+			    (named-call 'SVL-MEMBER? svl-member? svl value)))
+		       'EXPRESSION `(CHAR-SET-MEMBER? ,svl ,value)))))
+		(enumerate-test-values)))
+	 interesting-svls)))
+
+(define (enumerate-test-values)
+  (append (iota (+ %low-limit 8))
+	  (iota 8 (- char-code-limit 8))))
+
+(define (svl-member? svl value)
+  (let loop ((svl svl))
+    (if (pair? svl)
+	(if (and (<= (segment-start (car svl)) value)
+		 (< value (segment-end (car svl))))
+	    #t
+	    (loop (cdr svl)))
+	#f)))
 
 (define-test 'invert
   (lambda ()