Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-11 23:17:34 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

adding tests

Browse source
This commit is contained in:
Alex Shinn 2010-03-01 15:53:55 +09:00
parent 5002f796d8
commit 32de527a77
3 changed files with 128 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
Makefile
View file

@ -168,6 +168,9 @@ test-match: chibi-scheme$(EXE)
test-loop: chibi-scheme$(EXE)
LD_LIBRARY_PATH=.:$(LD_LIBRARY_PATH) ./chibi-scheme$(EXE) tests/loop-tests.scm
test-sort: chibi-scheme$(EXE)
LD_LIBRARY_PATH=.:$(LD_LIBRARY_PATH) ./chibi-scheme$(EXE) tests/sort-tests.scm
test: chibi-scheme$(EXE)
LD_LIBRARY_PATH=.:$(LD_LIBRARY_PATH) ./chibi-scheme$(EXE) tests/r5rs-tests.scm

74
tests/hash-tests.scm Normal file
View file

@ -0,0 +1,74 @@
(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*)
(display ". ")
(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)

51
tests/sort-tests.scm Normal file
View file

@ -0,0 +1,51 @@
(import (srfi 95))
(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 "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 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-report)