switching tests suites to use (chibi test)

Makefile

@@ -182,6 +182,9 @@ test-loop: chibi-scheme$(EXE)
 test-sort: chibi-scheme$(EXE)
 	LD_LIBRARY_PATH=".:$(LD_LIBRARY_PATH)" ./chibi-scheme$(EXE) tests/sort-tests.scm
 
+test-libs: chibi-scheme$(EXE)
+	LD_LIBRARY_PATH=".:$(LD_LIBRARY_PATH)" ./chibi-scheme$(EXE) tests/lib-tests.scm
+
 test: chibi-scheme$(EXE)
 	LD_LIBRARY_PATH=".:$(LD_LIBRARY_PATH)" ./chibi-scheme$(EXE) tests/r5rs-tests.scm
 

tests/flonum-tests.scm

@@ -0,0 +1,21 @@
+;;;; these will fail when compiled either without flonums or trig funcs
+
+(import (chibi test))
+
+(test-begin "floating point")
+
+(test-assert (= -5 (floor -4.3)))
+(test-assert (= -4 (ceiling -4.3)))
+(test-assert (= -4 (truncate -4.3)))
+(test-assert (= -4 (round -4.3)))
+(test-assert (= 3 (floor 3.5)))
+(test-assert (= 4 (ceiling 3.5)))
+(test-assert (= 3 (truncate 3.5)))
+(test-assert (= 4 (round 3.5)))
+
+(test 1124378190243790143.0 (exact->inexact 1124378190243790143))
+
+;; (test "1124378190243790143.0"
+;;     (number->string (exact->inexact 1124378190243790143)))
+
+(test-end)

tests/hash-tests.scm

@@ -1,44 +1,7 @@
 
-(import (srfi 69))
+(import (srfi 69) (chibi test))
 
-(define *tests-run* 0)
-(define *tests-passed* 0)
-
-(define-syntax test
-  (syntax-rules ()
-    ((test expect expr)
-     (begin
-       (set! *tests-run* (+ *tests-run* 1))
-       (let ((str (call-with-output-string
-                    (lambda (out)
-                      (write *tests-run* out)
-                      (display ". " out)
-                      (display 'expr out))))
-             (res expr))
-         (display str)
-         (write-char #\space)
-         (display (make-string (max 0 (- 72 (string-length str))) #\.))
-         (flush-output)
-         (cond
-          ((equal? res expect)
-           (set! *tests-passed* (+ *tests-passed* 1))
-           (display " [PASS]\n"))
-          (else
-           (display " [FAIL]\n")
-           (display "    expected ") (write expect)
-           (display " but got ") (write res) (newline))))))))
-
-(define (test-report)
-  (write *tests-passed*)
-  (display " out of ")
-  (write *tests-run*)
-  (display " passed (")
-  (write (* (/ *tests-passed* *tests-run*) 100))
-  (display "%)")
-  (newline))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; run tests
+(test-begin "hash")
 
 (test
  'white
@@ -70,5 +33,5 @@
      (hash-table-set! ht i (* i i)))
    (hash-table-ref/default ht 25 #f)))
 
-(test-report)
+(test-end)
 

tests/lib-tests.scm

@@ -0,0 +1,13 @@
+
+(import (chibi test))
+
+(test-begin "libraries")
+
+(load "tests/flonum-tests.scm")
+(load "tests/numeric-tests.scm")
+(load "tests/hash-tests.scm")
+(load "tests/sort-tests.scm")
+(load "tests/loop-tests.scm")
+(load "tests/match-tests.scm")
+
+(test-end)

tests/loop-tests.scm

@@ -1,40 +1,7 @@
 
-(import (chibi loop))
+(import (chibi loop) (chibi test))
 
-(define *tests-run* 0)
-(define *tests-passed* 0)
-
-(define-syntax test
-  (syntax-rules ()
-    ((test name expr expect)
-     (begin
-       (set! *tests-run* (+ *tests-run* 1))
-       (let ((str (call-with-output-string (lambda (out) (display name out))))
-             (res expr))
-         (display str)
-         (write-char #\space)
-         (display (make-string (max 0 (- 72 (string-length str))) #\.))
-         (flush-output)
-         (cond
-          ((equal? res expect)
-           (set! *tests-passed* (+ *tests-passed* 1))
-           (display " [PASS]\n"))
-          (else
-           (display " [FAIL]\n")
-           (display "    expected ") (write expect)
-           (display " but got ") (write res) (newline))))))))
-
-(define (test-report)
-  (write *tests-passed*)
-  (display " out of ")
-  (write *tests-run*)
-  (display " passed (")
-  (write (* (/ *tests-passed* *tests-run*) 100))
-  (display "%)")
-  (newline))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; run tests
+(test-begin "loops")
 
 (test
  "stepping"
@@ -198,5 +165,4 @@
          (for res (listing i)))
     => res))
 
-(test-report)
-
+(test-end)

tests/match-tests.scm

@@ -1,196 +1,135 @@
 
-(import (chibi match))
+(import (chibi match) (chibi test))
 
-(define *tests-run* 0)
-(define *tests-passed* 0)
+(test-begin "match")
 
-(define-syntax test
-  (syntax-rules ()
-    ((test name expr expect)
-     (begin
-       (set! *tests-run* (+ *tests-run* 1))
-       (let ((str (call-with-output-string (lambda (out) (display name out))))
-             (res expr))
-         (display str)
-         (write-char #\space)
-         (display (make-string (max 0 (- 72 (string-length str))) #\.))
-         (flush-output)
-         (cond
-          ((equal? res expect)
-           (set! *tests-passed* (+ *tests-passed* 1))
-           (display " [PASS]\n"))
-          (else
-           (display " [FAIL]\n")
-           (display "    expected ") (write expect)
-           (display " but got ") (write res) (newline))))))))
+(test "any" 'ok (match 'any (_ 'ok)))
+(test "symbol" 'ok (match 'ok (x x)))
+(test "number" 'ok (match 28 (28 'ok)))
+(test "string" 'ok (match "good" ("bad" 'fail) ("good" 'ok)))
+(test "literal symbol" 'ok (match 'good ('bad 'fail) ('good 'ok)))
+(test "null" 'ok (match '() (() 'ok)))
+(test "pair" 'ok (match '(ok) ((x) x)))
+(test "vector" 'ok (match '#(ok) (#(x) x)))
+(test "any doubled" 'ok (match '(1 2) ((_ _) 'ok)))
+(test "and empty" 'ok (match '(o k) ((and) 'ok)))
+(test "and single" 'ok (match 'ok ((and x) x)))
+(test "and double" 'ok (match 'ok ((and (? symbol?) y) 'ok)))
+(test "or empty" 'ok (match '(o k) ((or) 'fail) (else 'ok)))
+(test "or single" 'ok (match 'ok ((or x) 'ok)))
+(test "or double" 'ok (match 'ok ((or (? symbol? y) y) y)))
+(test "not" 'ok (match 28 ((not (a . b)) 'ok)))
+(test "pred" 'ok (match 28 ((? number?) 'ok)))
+(test "named pred" 29 (match 28 ((? number? x) (+ x 1))))
 
-(define (test-report)
-  (write *tests-passed*)
-  (display " out of ")
-  (write *tests-run*)
-  (display " passed (")
-  (write (* (/ *tests-passed* *tests-run*) 100))
-  (display "%)")
-  (newline))
+(test "duplicate symbols pass" 'ok (match '(ok . ok) ((x . x) x)))
+(test "duplicate symbols fail" 'ok (match '(ok . bad) ((x . x) 'bad) (else 'ok)))
+(test "duplicate symbols samth" 'ok (match '(ok . ok) ((x . 'bad) x) (('ok . x) x)))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; run tests
+(test "ellipses" '((a b c) (1 2 3))
+  (match '((a . 1) (b . 2) (c . 3))
+    (((x . y) ___) (list x y))))
 
-(test "any" (match 'any (_ 'ok)) 'ok)
-(test "symbol" (match 'ok (x x)) 'ok)
-(test "number" (match 28 (28 'ok)) 'ok)
-(test "string" (match "good" ("bad" 'fail) ("good" 'ok)) 'ok)
-(test "literal symbol" (match 'good ('bad 'fail) ('good 'ok)) 'ok)
-(test "null" (match '() (() 'ok)) 'ok)
-(test "pair" (match '(ok) ((x) x)) 'ok)
-(test "vector" (match '#(ok) (#(x) x)) 'ok)
-(test "any doubled" (match '(1 2) ((_ _) 'ok)) 'ok)
-(test "and empty" (match '(o k) ((and) 'ok)) 'ok)
-(test "and single" (match 'ok ((and x) x)) 'ok)
-(test "and double" (match 'ok ((and (? symbol?) y) 'ok)) 'ok)
-(test "or empty" (match '(o k) ((or) 'fail) (else 'ok)) 'ok)
-(test "or single" (match 'ok ((or x) 'ok)) 'ok)
-(test "or double" (match 'ok ((or (? symbol? y) y) y)) 'ok)
-(test "not" (match 28 ((not (a . b)) 'ok)) 'ok)
-(test "pred" (match 28 ((? number?) 'ok)) 'ok)
-(test "named pred" (match 28 ((? number? x) (+ x 1))) 29)
+(test "real ellipses" '((a b c) (1 2 3))
+  (match '((a . 1) (b . 2) (c . 3))
+    (((x . y) ...) (list x y))))
 
-(test "duplicate symbols pass" (match '(ok . ok) ((x . x) x)) 'ok)
-(test "duplicate symbols fail" (match '(ok . bad) ((x . x) 'bad) (else 'ok)) 'ok)
-(test "duplicate symbols samth" (match '(ok . ok) ((x . 'bad) x) (('ok . x) x)) 'ok)
+(test "vector ellipses" '(1 2 3 (a b c) (1 2 3))
+  (match '#(1 2 3 (a . 1) (b . 2) (c . 3))
+    (#(a b c (hd . tl) ...) (list a b c hd tl))))
 
-(test "ellipses"
-            (match '((a . 1) (b . 2) (c . 3))
-              (((x . y) ___) (list x y)))
-            '((a b c) (1 2 3)))
+(test "pred ellipses" '(1 2 3)
+  (match '(1 2 3)
+    (((? odd? n) ___) n)
+    (((? number? n) ___) n)))
 
-(test "real ellipses"
-            (match '((a . 1) (b . 2) (c . 3))
-              (((x . y) ...) (list x y)))
-            '((a b c) (1 2 3)))
+(test "failure continuation" 'ok
+  (match '(1 2)
+    ((a . b) (=> next) (if (even? a) 'fail (next)))
+    ((a . b) 'ok)))
 
-(test "vector ellipses"
-            (match '#(1 2 3 (a . 1) (b . 2) (c . 3))
-              (#(a b c (hd . tl) ...) (list a b c hd tl)))
-            '(1 2 3 (a b c) (1 2 3)))
+(test "let" '(o k)
+  (match-let ((x 'ok) (y '(o k))) y))
 
-(test "pred ellipses"
-            (match '(1 2 3)
-              (((? odd? n) ___) n)
-              (((? number? n) ___) n))
-            '(1 2 3))
+(test "let*" '(f o o f)
+  (match-let* ((x 'f) (y 'o) ((z w) (list y x))) (list x y z w)))
 
-(test "failure continuation"
-            (match '(1 2)
-              ((a . b) (=> next) (if (even? a) 'fail (next)))
-              ((a . b) 'ok))
-            'ok)
+(test "getter car" '(1 2)
+  (match '(1 . 2) (((get! a) . b) (list (a) b))))
 
-(test "let"
-            (match-let ((x 'ok) (y '(o k)))
-              y)
-            '(o k))
+(test "getter cdr" '(1 2)
+  (match '(1 . 2) ((a . (get! b)) (list a (b)))))
 
-(test "let*"
-            (match-let* ((x 'f) (y 'o) ((z w) (list y x)))
-              (list x y z w))
-            '(f o o f))
+(test "getter vector" '(1 2 3)
+  (match '#(1 2 3) (#((get! a) b c) (list (a) b c))))
 
-(test "getter car"
-            (match '(1 . 2) (((get! a) . b) (list (a) b)))
-            '(1 2))
+(test "setter car" '(3 . 2)
+  (let ((x (cons 1 2)))
+    (match x (((set! a) . b) (a 3)))
+    x))
 
-(test "getter cdr"
-            (match '(1 . 2) ((a . (get! b)) (list a (b))))
-            '(1 2))
+(test "setter cdr" '(1 . 3)
+  (let ((x (cons 1 2)))
+    (match x ((a . (set! b)) (b 3)))
+    x))
 
-(test "getter vector"
-            (match '#(1 2 3) (#((get! a) b c) (list (a) b c)))
-            '(1 2 3))
+(test "setter vector" '#(1 0 3)
+  (let ((x (vector 1 2 3)))
+    (match x (#(a (set! b) c) (b 0)))
+    x))
 
-(test "setter car"
-            (let ((x (cons 1 2)))
-              (match x (((set! a) . b) (a 3)))
-              x)
-            '(3 . 2))
+(test "single tail" '((a b) (1 2) (c . 3))
+  (match '((a . 1) (b . 2) (c . 3))
+    (((x . y) ... last) (list x y last))))
 
-(test "setter cdr"
-            (let ((x (cons 1 2)))
-              (match x ((a . (set! b)) (b 3)))
-              x)
-            '(1 . 3))
+(test "single tail 2" '((a b) (1 2) 3)
+  (match '((a . 1) (b . 2) 3)
+    (((x . y) ... last) (list x y last))))
 
-(test "setter vector"
-            (let ((x (vector 1 2 3)))
-              (match x (#(a (set! b) c) (b 0)))
-              x)
-            '#(1 0 3))
+(test "multiple tail" '((a b) (1 2) (c . 3) (d . 4) (e . 5))
+  (match '((a . 1) (b . 2) (c . 3) (d . 4) (e . 5))
+    (((x . y) ... u v w) (list x y u v w))))
 
-(test "single tail"
-            (match '((a . 1) (b . 2) (c . 3))
-              (((x . y) ... last) (list x y last)))
-            '((a b) (1 2) (c . 3)))
+(test "Riastradh quasiquote" '(2 3)
+  (match '(1 2 3) (`(1 ,b ,c) (list b c))))
 
-(test "single tail 2"
-            (match '((a . 1) (b . 2) 3)
-              (((x . y) ... last) (list x y last)))
-            '((a b) (1 2) 3))
+(test "trivial tree search" '(1 2 3)
+  (match '(1 2 3) ((_ *** (a b c)) (list a b c))))
 
-(test "multiple tail"
-            (match '((a . 1) (b . 2) (c . 3) (d . 4) (e . 5))
-              (((x . y) ... u v w) (list x y u v w)))
-            '((a b) (1 2) (c . 3) (d . 4) (e . 5)))
+(test "simple tree search" '(1 2 3)
+  (match '(x (1 2 3)) ((_ *** (a b c)) (list a b c))))
 
-(test "Riastradh quasiquote"
-            (match '(1 2 3) (`(1 ,b ,c) (list b c)))
-            '(2 3))
+(test "deep tree search" '(1 2 3)
+  (match '(x (x (x (1 2 3)))) ((_ *** (a b c)) (list a b c))))
 
-(test "trivial tree search"
-            (match '(1 2 3) ((_ *** (a b c)) (list a b c)))
-            '(1 2 3))
+(test "non-tail tree search" '(1 2 3)
+  (match '(x (x (x a b c (1 2 3) d e f))) ((_ *** (a b c)) (list a b c))))
 
-(test "simple tree search"
-            (match '(x (1 2 3)) ((_ *** (a b c)) (list a b c)))
-            '(1 2 3))
+(test "restricted tree search" '(1 2 3)
+  (match '(x (x (x a b c (1 2 3) d e f))) (('x *** (a b c)) (list a b c))))
 
-(test "deep tree search"
-            (match '(x (x (x (1 2 3)))) ((_ *** (a b c)) (list a b c)))
-            '(1 2 3))
+(test "fail restricted tree search" #f
+  (match '(x (y (x a b c (1 2 3) d e f)))
+    (('x *** (a b c)) (list a b c))
+    (else #f)))
 
-(test "non-tail tree search"
-            (match '(x (x (x a b c (1 2 3) d e f))) ((_ *** (a b c)) (list a b c)))
-            '(1 2 3))
+(test "sxml tree search" '(((href . "http://synthcode.com/")) ("synthcode"))
+  (match '(p (ul (li a (b c) (a (^ (href . "http://synthcode.com/")) "synthcode") d e f)))
+    (((or 'p 'ul 'li 'b) *** ('a ('^ attrs ...) text ...))
+     (list attrs text))
+    (else #f)))
 
-(test "restricted tree search"
-            (match '(x (x (x a b c (1 2 3) d e f))) (('x *** (a b c)) (list a b c)))
-            '(1 2 3))
-
-(test "fail restricted tree search"
-            (match '(x (y (x a b c (1 2 3) d e f)))
-              (('x *** (a b c)) (list a b c))
-              (else #f))
-            #f)
-
-(test "sxml tree search"
-    (match '(p (ul (li a (b c) (a (^ (href . "http://synthcode.com/")) "synthcode") d e f)))
-      (((or 'p 'ul 'li 'b) *** ('a ('^ attrs ...) text ...))
-       (list attrs text))
-      (else #f))
-  '(((href . "http://synthcode.com/")) ("synthcode")))
-
-(test "failed sxml tree search"
-    (match '(p (ol (li a (b c) (a (^ (href . "http://synthcode.com/")) "synthcode") d e f)))
-      (((or 'p 'ul 'li 'b) *** ('a ('^ attrs ...) text ...))
-       (list attrs text))
-      (else #f))
-  #f)
+(test "failed sxml tree search" #f
+  (match '(p (ol (li a (b c) (a (^ (href . "http://synthcode.com/")) "synthcode") d e f)))
+    (((or 'p 'ul 'li 'b) *** ('a ('^ attrs ...) text ...))
+     (list attrs text))
+    (else #f)))
 
 (test "collect tree search"
-    (match '(p (ul (li a (b c) (a (^ (href . "http://synthcode.com/")) "synthcode") d e f)))
-      (((and tag (or 'p 'ul 'li 'b)) *** ('a ('^ attrs ...) text ...))
-       (list tag attrs text))
-      (else #f))
-  '((p ul li) ((href . "http://synthcode.com/")) ("synthcode")))
-
-(test-report)
+    '((p ul li) ((href . "http://synthcode.com/")) ("synthcode"))
+  (match '(p (ul (li a (b c) (a (^ (href . "http://synthcode.com/")) "synthcode") d e f)))
+    (((and tag (or 'p 'ul 'li 'b)) *** ('a ('^ attrs ...) text ...))
+     (list tag attrs text))
+    (else #f)))
 
+(test-end)

tests/numeric-tests.scm

@@ -2,39 +2,9 @@
 ;; these tests are only valid if chibi-scheme is compiled with full
 ;; numeric support (USE_BIGNUMS, USE_FLONUMS and USE_MATH)
 
-(define *tests-run* 0)
-(define *tests-passed* 0)
+(import (chibi test))
 
-(define-syntax test
-  (syntax-rules ()
-    ((test expect expr)
-     (begin
-       (set! *tests-run* (+ *tests-run* 1))
-       (let ((str (call-with-output-string (lambda (out) (display 'expr out))))
-             (res expr))
-         (display str)
-         (write-char #\space)
-         (display (make-string (max 0 (- 72 (string-length str))) #\.))
-         (flush-output)
-         (cond
-          ((equal? res expect)
-           (set! *tests-passed* (+ *tests-passed* 1))
-           (display " [PASS]\n"))
-          (else
-           (display " [FAIL]\n")
-           (display "    expected ") (write expect)
-           (display " but got ") (write res) (newline))))))))
-
-(define (test-report)
-  (write *tests-passed*)
-  (display " out of ")
-  (write *tests-run*)
-  (display " passed (")
-  (write (* (/ *tests-passed* *tests-run*) 100))
-  (display "%)")
-  (newline))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test-begin "numbers")
 
 (define (integer-neighborhoods x)
   (list x (+ 1 x) (+ -1 x) (- x) (- 1 x) (- -1 x)))
@@ -147,4 +117,4 @@
         (-18446744078004518913 -18446744069414584321 79228162514264337597838917632 4294967296 -1))
     (sign-combinations (+ 1 (expt 2 64)) (expt 2 32)))
 
-(test-report)
+(test-end)

tests/sort-tests.scm

@@ -1,57 +1,40 @@
 
-(import (srfi 95))
+(import (srfi 95) (chibi test))
 
-(define *tests-run* 0)
-(define *tests-passed* 0)
+(test-begin "sorting")
 
-(define-syntax test
-  (syntax-rules ()
-    ((test name expr expect)
-     (begin
-       (set! *tests-run* (+ *tests-run* 1))
-       (let ((str (call-with-output-string (lambda (out) (display name out))))
-             (res expr))
-         (display str)
-         (write-char #\space)
-         (display (make-string (max 0 (- 72 (string-length str))) #\.))
-         (flush-output)
-         (cond
-          ((equal? res expect)
-           (set! *tests-passed* (+ *tests-passed* 1))
-           (display " [PASS]\n"))
-          (else
-           (display " [FAIL]\n")
-           (display "    expected ") (write expect)
-           (display " but got ") (write res) (newline))))))))
-
-(define (test-report)
-  (write *tests-passed*)
-  (display " out of ")
-  (write *tests-run*)
-  (display " passed (")
-  (write (* (/ *tests-passed* *tests-run*) 100))
-  (display "%)")
-  (newline))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; run tests
-
-(test "sort null" (sort '()) '())
-(test "sort null <" (sort '() <) '())
-(test "sort null < car" (sort '() < car) '())
-(test "sort list" (sort '(7 5 2 8 1 6 4 9 3)) '(1 2 3 4 5 6 7 8 9))
-(test "sort list <" (sort '(7 5 2 8 1 6 4 9 3) <) '(1 2 3 4 5 6 7 8 9))
-(test "sort list < car" (sort '((7) (5) (2) (8) (1) (6) (4) (9) (3)) < car)
-  '((1) (2) (3) (4) (5) (6) (7) (8) (9)))
+(test "sort null" '() (sort '()))
+(test "sort null <" '() (sort '() <))
+(test "sort null < car" '() (sort '() < car))
+(test "sort ordered list" '(1 2 3 4 5 6 7 8 9) (sort '(1 2 3 4 5 6 7 8 9)))
+(test "sort reversed list" '(1 2 3 4 5 6 7 8 9) (sort '(9 8 7 6 5 4 3 2 1)))
+(test "sort random list 1" '(1 2 3 4 5 6 7 8 9) (sort '(7 5 2 8 1 6 4 9 3)))
+(test "sort random list 2" '(1 2 3 4 5 6 7 8) (sort '(5 3 4 1 7 6 8 2)))
+(test "sort random list 3" '(1 2 3 4 5 6 7 8 9) (sort '(5 3 4 1 7 9 6 8 2)))
+(test "sort numeric list <" '(1 2 3 4 5 6 7 8 9)
+  (sort '(7 5 2 8 1 6 4 9 3) <))
+(test "sort numeric list < car" '((1) (2) (3) (4) (5) (6) (7) (8) (9))
+  (sort '((7) (5) (2) (8) (1) (6) (4) (9) (3)) < car))
 (test "sort list (lambda (a b) (< (car a) (car b)))"
-    (sort '((7) (5) (2) (8) (1) (6) (4) (9) (3))
-          (lambda (a b) (< (car a) (car b))))
-  '((1) (2) (3) (4) (5) (6) (7) (8) (9)))
-(test "sort 1-char symbols" (sort '(h b k d a c j i e g f))
-  '(a b c d e f g h i j k))
-(test "sort short symbols" (sort '(h b aa k d a ee c j i e g f))
-  '(a aa b c d e ee f g h i j k))
-(test "sort long symbols" (sort '(h b aa k d a ee c j i bzzzzzzzzzzzzzzzzzzzzzzz e g f))
-  '(a aa b bzzzzzzzzzzzzzzzzzzzzzzz c d e ee f g h i j k))
+    '((1) (2) (3) (4) (5) (6) (7) (8) (9))
+  (sort '((7) (5) (2) (8) (1) (6) (4) (9) (3))
+        (lambda (a b) (< (car a) (car b)))))
+(test "sort 1-char symbols" '(a b c d e f g h i j k)
+  (sort '(h b k d a c j i e g f)))
+(test "sort short symbols" '(a aa b c d e ee f g h i j k)
+  (sort '(h b aa k d a ee c j i e g f)))
+(test "sort long symbol"
+    '(a aa b bzzzzzzzzzzzzzzzzzzzzzzz c d e ee f g h i j k)
+  (sort '(h b aa k d a ee c j i bzzzzzzzzzzzzzzzzzzzzzzz e g f)))
+(test "sort long symbols"
+    '(a aa b bzzzzzzzzzzzzzzzzzzzzzzz czzzzzzzzzzzzz dzzzzzzzz e ee f g h i j k)
+  (sort '(h b aa k dzzzzzzzz a ee czzzzzzzzzzzzz j i bzzzzzzzzzzzzzzzzzzzzzzz e g f)))
+(test "sort strings"
+    '("ape" "bear" "cat" "dog" "elephant" "fox" "goat" "hawk")
+  (sort '("elephant" "cat" "dog" "ape" "goat" "fox" "hawk" "bear")))
+(test "sort strings string-ci<?"
+    '("ape" "Bear" "CaT" "DOG" "elephant" "Fox" "GoAt" "HAWK")
+  (sort '("elephant" "CaT" "DOG" "ape" "GoAt" "Fox" "HAWK" "Bear")
+          string-ci<?))
 
-(test-report)
+(test-end)

tests/thread-tests.scm

@@ -1,40 +1,7 @@
 
-(import (srfi 18))
+(import (srfi 18) (chibi test))
 
-(define *tests-run* 0)
-(define *tests-passed* 0)
-
-(define-syntax test
-  (syntax-rules ()
-    ((test name expr expect)
-     (begin
-       (set! *tests-run* (+ *tests-run* 1))
-       (let ((str (call-with-output-string (lambda (out) (display name out))))
-             (res expr))
-         (display str)
-         (write-char #\space)
-         (display (make-string (max 0 (- 72 (string-length str))) #\.))
-         (flush-output)
-         (cond
-          ((equal? res expect)
-           (set! *tests-passed* (+ *tests-passed* 1))
-           (display " [PASS]\n"))
-          (else
-           (display " [FAIL]\n")
-           (display "    expected ") (write expect)
-           (display " but got ") (write res) (newline))))))))
-
-(define (test-report)
-  (write *tests-passed*)
-  (display " out of ")
-  (write *tests-run*)
-  (display " passed (")
-  (write (* (/ *tests-passed* *tests-run*) 100))
-  (display "%)")
-  (newline))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; run tests
+(test-begin)
 
 (test "no threads" (begin 'ok) 'ok)
 (test "unstarted thread" (let ((t (make-thread (lambda () (error "oops"))))) 'ok) 'ok)
@@ -54,5 +21,5 @@
 
 ;(test "mailbox")
 
-(test-report)
+(test-end)