(define-library (picrin test) (import (picrin base) (picrin syntax-rules)) (define test-counter 0) (define counter 0) (define failure-counter 0) (define fails '()) (define (print-statistics) (newline) (display "Test Result: ") (write (- counter failure-counter)) (display " / ") (write counter) (display " (") (write (* (/ (- counter failure-counter) counter) 100)) (display "%)") (display " [PASS/TOTAL]") (display "") (newline) (for-each (lambda (fail) (display fail)) (reverse fails))) (define (test-begin . o) (set! test-counter (+ test-counter 1))) (define (test-end . o) (set! test-counter (- test-counter 1)) (if (= test-counter 0) (print-statistics))) (define-syntax test (syntax-rules () ((test expected expr) (let ((res expr)) (display "case ") (write counter) (cond ((equal? res expected) (display " PASS: ") (write 'expr) (display " equals ") (write expected) (display "") (newline) ) ((not (equal? res expected)) (set! failure-counter (+ failure-counter 1)) (let ((out (open-output-string))) (display " FAIL: " out) (write 'expr out) (newline out) (display " expected " out) (write expected out) (display " but got " out) (write res out) (display "" out) (newline out) (let ((str (get-output-string out))) (set! fails (cons str fails)) (display str))))) (set! counter (+ counter 1)))))) (define-syntax test-values (syntax-rules () ((_ expect expr) (test (call-with-values (lambda () expect) (lambda results results)) (call-with-values (lambda () expr) (lambda results results)))))) (define (test-failure-count) (length fails)) (define-syntax test-syntax-error (syntax-rules () ((_) (syntax-error "invalid use of test-syntax-error")))) (export test test-begin test-end test-values test-syntax-error))