Skip to content
Browse files

Add tests for SRFI-14

Tests by Olin Shivers for the SRFI-14 reference implementation
(http://srfi.schemers.org/srfi-14/srfi-14-tests.scm).

Those tests triggered a compiler bug
(http://bugs.call-cc.org/ticket/874) which has been fixed by
285f53d
  • Loading branch information...
1 parent cb1fa35 commit 633dccaf8081e62c6b72c9419715badf0cc25473 @mario-goulart mario-goulart committed with Jul 7, 2012
Showing with 207 additions and 0 deletions.
  1. +1 −0 distribution/manifest
  2. +4 −0 tests/runtests.sh
  3. +202 −0 tests/srfi-14-tests.scm
View
1 distribution/manifest
@@ -115,6 +115,7 @@ tests/runtests.sh
tests/runbench.sh
tests/srfi-4-tests.scm
tests/srfi-13-tests.scm
+tests/srfi-14-tests.scm
tests/simple-thread-test.scm
tests/mutex-test.scm
tests/hash-table-tests.scm
View
4 tests/runtests.sh
@@ -232,6 +232,10 @@ $interpret -s srfi-4-tests.scm
echo "======================================== srfi-13 tests ..."
$interpret -s srfi-13-tests.scm
+echo "======================================== srfi-14 tests ..."
+$compile srfi-14-tests.scm
+./a.out
+
echo "======================================== condition tests ..."
$interpret -s condition-tests.scm
View
202 tests/srfi-14-tests.scm
@@ -0,0 +1,202 @@
+;;; This is a regression testing suite for the SRFI-14 char-set library.
+;;; Olin Shivers
+
+(use srfi-14)
+
+(let-syntax ((test (syntax-rules ()
+ ((test form ...)
+ (cond ((not form) (error "Test failed" 'form)) ...
+ (else 'OK))))))
+ (let ((vowel? (lambda (c) (member c '(#\a #\e #\i #\o #\u)))))
+
+(test
+ (not (char-set? 5))
+
+ (char-set? (char-set #\a #\e #\i #\o #\u))
+
+ (char-set=)
+ (char-set= (char-set))
+
+ (char-set= (char-set #\a #\e #\i #\o #\u)
+ (string->char-set "ioeauaiii"))
+
+ (not (char-set= (char-set #\e #\i #\o #\u)
+ (string->char-set "ioeauaiii")))
+
+ (char-set<=)
+ (char-set<= (char-set))
+
+ (char-set<= (char-set #\a #\e #\i #\o #\u)
+ (string->char-set "ioeauaiii"))
+
+ (char-set<= (char-set #\e #\i #\o #\u)
+ (string->char-set "ioeauaiii"))
+
+ (<= 0 (char-set-hash char-set:graphic 100) 99)
+
+ (= 4 (char-set-fold (lambda (c i) (+ i 1)) 0
+ (char-set #\e #\i #\o #\u #\e #\e)))
+
+ (char-set= (string->char-set "eiaou2468013579999")
+ (char-set-unfold null? car cdr '(#\a #\e #\i #\o #\u #\u #\u)
+ char-set:digit))
+
+ (char-set= (string->char-set "eiaou246801357999")
+ (char-set-unfold! null? car cdr '(#\a #\e #\i #\o #\u)
+ (string->char-set "0123456789")))
+
+ (not (char-set= (string->char-set "eiaou246801357")
+ (char-set-unfold! null? car cdr '(#\a #\e #\i #\o #\u)
+ (string->char-set "0123456789"))))
+
+ (let ((cs (string->char-set "0123456789")))
+ (char-set-for-each (lambda (c) (set! cs (char-set-delete cs c)))
+ (string->char-set "02468000"))
+ (char-set= cs (string->char-set "97531")))
+
+ (not (let ((cs (string->char-set "0123456789")))
+ (char-set-for-each (lambda (c) (set! cs (char-set-delete cs c)))
+ (string->char-set "02468"))
+ (char-set= cs (string->char-set "7531"))))
+
+ (char-set= (char-set-map char-upcase (string->char-set "aeiou"))
+ (string->char-set "IOUAEEEE"))
+
+ (not (char-set= (char-set-map char-upcase (string->char-set "aeiou"))
+ (string->char-set "OUAEEEE")))
+
+ (char-set= (char-set-copy (string->char-set "aeiou"))
+ (string->char-set "aeiou"))
+
+ (char-set= (char-set #\x #\y) (string->char-set "xy"))
+ (not (char-set= (char-set #\x #\y #\z) (string->char-set "xy")))
+
+ (char-set= (string->char-set "xy") (list->char-set '(#\x #\y)))
+ (not (char-set= (string->char-set "axy") (list->char-set '(#\x #\y))))
+
+ (char-set= (string->char-set "xy12345")
+ (list->char-set '(#\x #\y) (string->char-set "12345")))
+ (not (char-set= (string->char-set "y12345")
+ (list->char-set '(#\x #\y) (string->char-set "12345"))))
+
+ (char-set= (string->char-set "xy12345")
+ (list->char-set! '(#\x #\y) (string->char-set "12345")))
+ (not (char-set= (string->char-set "y12345")
+ (list->char-set! '(#\x #\y) (string->char-set "12345"))))
+
+ (char-set= (string->char-set "aeiou12345")
+ (char-set-filter vowel? char-set:ascii (string->char-set "12345")))
+ (not (char-set= (string->char-set "aeou12345")
+ (char-set-filter vowel? char-set:ascii (string->char-set "12345"))))
+
+ (char-set= (string->char-set "aeiou12345")
+ (char-set-filter! vowel? char-set:ascii (string->char-set "12345")))
+ (not (char-set= (string->char-set "aeou12345")
+ (char-set-filter! vowel? char-set:ascii (string->char-set "12345"))))
+
+
+ (char-set= (string->char-set "abcdef12345")
+ (ucs-range->char-set 97 103 #t (string->char-set "12345")))
+ (not (char-set= (string->char-set "abcef12345")
+ (ucs-range->char-set 97 103 #t (string->char-set "12345"))))
+
+ (char-set= (string->char-set "abcdef12345")
+ (ucs-range->char-set! 97 103 #t (string->char-set "12345")))
+ (not (char-set= (string->char-set "abcef12345")
+ (ucs-range->char-set! 97 103 #t (string->char-set "12345"))))
+
+
+ (char-set= (->char-set #\x)
+ (->char-set "x")
+ (->char-set (char-set #\x)))
+
+ (not (char-set= (->char-set #\x)
+ (->char-set "y")
+ (->char-set (char-set #\x))))
+
+ (= 10 (char-set-size (char-set-intersection char-set:ascii char-set:digit)))
+
+ (= 5 (char-set-count vowel? char-set:ascii))
+
+ (equal? '(#\x) (char-set->list (char-set #\x)))
+ (not (equal? '(#\X) (char-set->list (char-set #\x))))
+
+ (equal? "x" (char-set->string (char-set #\x)))
+ (not (equal? "X" (char-set->string (char-set #\x))))
+
+ (char-set-contains? (->char-set "xyz") #\x)
+ (not (char-set-contains? (->char-set "xyz") #\a))
+
+ (char-set-every char-lower-case? (->char-set "abcd"))
+ (not (char-set-every char-lower-case? (->char-set "abcD")))
+ (char-set-any char-lower-case? (->char-set "abcd"))
+ (not (char-set-any char-lower-case? (->char-set "ABCD")))
+
+ (char-set= (->char-set "ABCD")
+ (let ((cs (->char-set "abcd")))
+ (let lp ((cur (char-set-cursor cs)) (ans '()))
+ (if (end-of-char-set? cur) (list->char-set ans)
+ (lp (char-set-cursor-next cs cur)
+ (cons (char-upcase (char-set-ref cs cur)) ans))))))
+
+
+ (char-set= (char-set-adjoin (->char-set "123") #\x #\a)
+ (->char-set "123xa"))
+ (not (char-set= (char-set-adjoin (->char-set "123") #\x #\a)
+ (->char-set "123x")))
+ (char-set= (char-set-adjoin! (->char-set "123") #\x #\a)
+ (->char-set "123xa"))
+ (not (char-set= (char-set-adjoin! (->char-set "123") #\x #\a)
+ (->char-set "123x")))
+
+ (char-set= (char-set-delete (->char-set "123") #\2 #\a #\2)
+ (->char-set "13"))
+ (not (char-set= (char-set-delete (->char-set "123") #\2 #\a #\2)
+ (->char-set "13a")))
+ (char-set= (char-set-delete! (->char-set "123") #\2 #\a #\2)
+ (->char-set "13"))
+ (not (char-set= (char-set-delete! (->char-set "123") #\2 #\a #\2)
+ (->char-set "13a")))
+
+ (char-set= (char-set-intersection char-set:hex-digit (char-set-complement char-set:digit))
+ (->char-set "abcdefABCDEF"))
+ (char-set= (char-set-intersection! (char-set-complement! (->char-set "0123456789"))
+ char-set:hex-digit)
+ (->char-set "abcdefABCDEF"))
+
+ (char-set= (char-set-union char-set:hex-digit
+ (->char-set "abcdefghijkl"))
+ (->char-set "abcdefABCDEFghijkl0123456789"))
+ (char-set= (char-set-union! (->char-set "abcdefghijkl")
+ char-set:hex-digit)
+ (->char-set "abcdefABCDEFghijkl0123456789"))
+
+ (char-set= (char-set-difference (->char-set "abcdefghijklmn")
+ char-set:hex-digit)
+ (->char-set "ghijklmn"))
+ (char-set= (char-set-difference! (->char-set "abcdefghijklmn")
+ char-set:hex-digit)
+ (->char-set "ghijklmn"))
+
+ (char-set= (char-set-xor (->char-set "0123456789")
+ char-set:hex-digit)
+ (->char-set "abcdefABCDEF"))
+ (char-set= (char-set-xor! (->char-set "0123456789")
+ char-set:hex-digit)
+ (->char-set "abcdefABCDEF"))
+
+ (call-with-values (lambda ()
+ (char-set-diff+intersection char-set:hex-digit
+ char-set:letter))
+ (lambda (d i)
+ (and (char-set= d (->char-set "0123456789"))
+ (char-set= i (->char-set "abcdefABCDEF")))))
+
+ (call-with-values (lambda ()
+ (char-set-diff+intersection! (char-set-copy char-set:hex-digit)
+ (char-set-copy char-set:letter)))
+ (lambda (d i)
+ (and (char-set= d (->char-set "0123456789"))
+ (char-set= i (->char-set "abcdefABCDEF"))))))
+
+))

0 comments on commit 633dcca

Please sign in to comment.
Something went wrong with that request. Please try again.