diff options
Diffstat (limited to 'testing.csc')
| -rw-r--r-- | testing.csc | 101 |
1 files changed, 34 insertions, 67 deletions
diff --git a/testing.csc b/testing.csc index f221388..aebc574 100644 --- a/testing.csc +++ b/testing.csc @@ -1,19 +1,13 @@ (define-library (csc testing) (export - define-test - errorf - fatalf - test-main - subtest) + assert + assert-equal + test + test-main) (import (scheme base) (only (csc format) - printf - sprintf) - (only (csc vec) - vec - vec-append - vec-length - vec-ref)) + printf + sprintf)) (begin @@ -24,19 +18,9 @@ (define-record-type <test-handle> - (make-test-handle test-name subtest-name succeeded subtests-succeeded) + (make-test-handle test-name) test-handle? - (test-name base-test-name) - (subtest-name subtest-name) - (succeeded test-succeeded? set-succeeded!) - (subtests-succeeded subtests-succeeded set-subtests-succeeded!)) - - - (define (test-name t) - (let ((sn (subtest-name t))) - (if (equal? sn "") - (base-test-name t) - (sprintf "{}/{}" (base-test-name t) sn)))) + (test-name test-name set-name!)) (define-record-type <test-error> @@ -44,58 +28,41 @@ test-error?) - (define-syntax define-test + (define *test-handle* (make-test-handle "global")) + + + (define-syntax test (syntax-rules () - ((_ (name t) body ...) - (let ((t (make-test-handle (symbol->string 'name) "" #t (vec)))) - (printf "=== RUN {}\n" 'name) - (guard (e ((test-error? e)) - #;(else - (errorf t "{}" e))) - body ...) - (if (test-succeeded? t) - (printf "--- PASS: {}\n" 'name) - (begin - (printf "--- FAIL: {}\n" 'name) - (set-all-succeeded! #f))) - (do ((i 0 (+ 1 i))) - ((>= i (vec-length (subtests-succeeded t)))) - (printf " --- {}: {}/{}\n" - (if (cdr (vec-ref (subtests-succeeded t) i)) "PASS" "FAIL") - 'name - (car (vec-ref (subtests-succeeded t) i)))))))) + ((test name body body* ...) + (begin + (set-name! *test-handle* (symbol->string 'name)) + (printf "=== RUN {}\n" 'name) + (guard (e ((test-error? e) + (printf "--- FAIL: {}\n" 'name) + (set-all-succeeded! #f))) + body body* ... + (printf "--- PASS: {}\n" 'name)))))) - (define-syntax subtest - (syntax-rules () - ((_ t name body ...) - (let ((old-t t) - (t (make-test-handle (test-name t) name #t (vec)))) - (printf "=== RUN {}\n" (test-name t)) - (guard (e ((test-error? e)) - #;(else - (errorf t "{}" e))) - body ...) - (let ((succ (test-succeeded? t))) - (set-subtests-succeeded! old-t (vec-append (subtests-succeeded old-t) (cons name succ))) - (unless succ - (set-succeeded! old-t #f))))))) + (define (fatalf format-string . format-args) + (printf "{}: {}\n" (test-name *test-handle*) (apply sprintf format-string format-args)) + (raise (make-test-error))) - (define-syntax errorf + (define-syntax assert (syntax-rules () - ((_ t format-string format-args ...) - (begin - (set-succeeded! t #f) - (printf "{}: {}\n" (test-name t) (sprintf format-string format-args ...)))))) + ((assert expr) + (unless expr + (fatalf "Assertion {} failed." 'expr))))) - (define-syntax fatalf + (define-syntax assert-equal (syntax-rules () - ((_ t format-string format-args ...) - (begin - (errorf t format-string format-args ...) - (raise (make-test-error)))))) + ((assert-equal left right) + (let ((x left) + (y right)) + (unless (equal? x y) + (fatalf "Fatal: {} is not equal to {}.\nleft is {}\nright is {}" 'left 'right x y)))))) (define (test-main) |