mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-21 06:39:17 +02:00
74 lines
1.9 KiB
Scheme
74 lines
1.9 KiB
Scheme
|
|
(import (srfi 69))
|
|
|
|
(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
|
|
'white
|
|
(let ((ht (make-hash-table eq?)))
|
|
(hash-table-set! ht 'cat 'black)
|
|
(hash-table-set! ht 'dog 'white)
|
|
(hash-table-set! ht 'elephant 'pink)
|
|
(hash-table-ref/default ht 'dog #f)))
|
|
|
|
(test
|
|
'white
|
|
(let ((ht (make-hash-table equal?)))
|
|
(hash-table-set! ht "cat" 'black)
|
|
(hash-table-set! ht "dog" 'white)
|
|
(hash-table-set! ht "elephant" 'pink)
|
|
(hash-table-ref/default ht "dog" #f)))
|
|
|
|
(test
|
|
'white
|
|
(let ((ht (make-hash-table string-ci=? string-ci-hash)))
|
|
(hash-table-set! ht "cat" 'black)
|
|
(hash-table-set! ht "dog" 'white)
|
|
(hash-table-set! ht "elephant" 'pink)
|
|
(hash-table-ref/default ht "DOG" #f)))
|
|
|
|
(test 625
|
|
(let ((ht (make-hash-table)))
|
|
(do ((i 0 (+ i 1))) ((= i 1000))
|
|
(hash-table-set! ht i (* i i)))
|
|
(hash-table-ref/default ht 25 #f)))
|
|
|
|
(test-report)
|
|
|