Scheme Unit

There's a complete implementation for DrScheme at The manual is at

Interesting, but very DrScheme-specific. I think something can be written which has similar functionality (except for the GUI) in fully standard R5RS Scheme. -- StephanHouben

There is a new version that isn't as DrScheme specific. The only two things are the structure definitions and the module system and any decent Scheme has equivalents for these. -- NoelWelsh

Well, here's a start (umb-scheme). At least its gotten me through chapter 2 of StructureAndInterpretationOfComputerPrograms :) -- JohnClonts

 ;  Unit test framework for scheme

(define (reportmsg msg) (display msg) (newline))

(define (reporterr msg) (display "ERROR: ") (display msg) (newline))

(define (assert msg b) ( if ( not b) (reporterr msg)))

(define (asserteq msg a b) ( assert msg ( > 0.0001 (abs ( - a b)))))

See also: CommonLispUnit, LispMeUnit

It's not in the Scheme standard, but many Schemes support something like
  (error "My error message")
This halts the program and often gives the programmer a choice to see a back trace or something like that.

If the Scheme in question doesn't support this, my usual workaround is
  (define error apply)
which causes the interpreter to throw a "Can't apply string: 'My error message'" complaint or similar, which is sub-optimal but usually Good Enough for testing

 ;; Here is a simple start with standard macros. 
 ;; One could change it to return some useful value.
 ;; -Ken Dickey

(define-syntax unless (syntax-rules () ((unless ?form ?clause ...) ;=> (if (not ?form) (begin ?clause ...))) ) )

(define-syntax when (syntax-rules () ((when ?form ?clause ...) ;=> (if ?form (begin ?clause ...))) ) )

; set! #t to avoid breaking into the debugger (define treat-errors-as-warnings #f)

;; Light weight unit testing.. ;; TODO: wrap w general exception handler & restart (define-syntax expect (syntax-rules () ((expect ?expected ?form) ;=> (expect ?expected ?form equal?) ) ((expect ?expected ?form ?compare) ;=> (let ( (expected ?expected) (actual ?form) ) (unless (?compare expected actual) ((if treat-errors-as-warnings warn error) (format #f "~% expected: ~a~% got: ~a~% from: ~g" expected actual '?form)))) ) ) )


;; Examples from STk Reference Manual

;; slot inheritance

(define-class <A> () (a)) (define-class <B> () (b)) (define-class <C> () (c)) (define-class <D> (<A> <B>) (d a)) (define-class <E> (<A> <C>) (e c)) (define-class <F> (<D> <E>) (f))

(expect '(a) (class-slots <A>) lset=) (expect '(a e c) (class-slots <E>) lset=) (expect '(a b c d e f) (class-slots <F>) lset=)

;; class precidence

(expect '(<F> <D> <E> <A> <B> <C> <object> <top>) (map class-name (class-precedence-list <F>)) equal?)

Here's another, written using scsh, but probably adaptable to other Schemes as well. I attempted to retain the flavor of the StarUnit testers, though it may be a bit strange in Scheme. -- RobertChurch (with thanks to EmilioLopes for fixing a bug).

 ;; A simple unit testing framework for scsh.

,open handle ; we need `with-handler'

(define *tests* '()) (define *test-failures* '())

;; ;; 'assert' comes from Rolf-Thomas Hoppe's 'krims' package at ;; ;;

(define-syntax assert (syntax-rules () ((assert ?x ?y0 ...) (if (not ?x) (error "Assertion failed" '?x ?y0 ...))) ))

(define-syntax define-tests (syntax-rules () ((define-tests ?suite-name ?bindings (?name1 ?body1 ...) ...) (set-test-suite! '?suite-name (list (cons '?name1 (lambda() (let* ?bindings ?body1 ...))) ...)))))

(define (set-test-suite! name tests) (if (assq name *tests*) (set-cdr! (assq name *tests*) tests) (set! *tests* (alist-cons name tests *tests*))))

(define (find-test-by-name suite-name test-name default-thunk) (let* ((suite (assq suite-name *tests*)) (test (assq test-name (cdr suite)))) (if (not test) default-thunk (cdr test))))

(define (setup-thunk suite-name) (find-test-by-name suite-name 'setup (lambda () #f)))

(define (teardown-thunk suite-name) (find-test-by-name suite-name 'teardown (lambda () #f)))

(define (test-thunks suite-name) ;; Returns the test routines, filtering out 'setup and 'teardown forms. (let ((suite (assq suite-name *tests*))) (remove (lambda (tst) (or (eq? 'setup (car tst)) (eq? 'teardown (car tst)))) (cdr suite))))

(define (with-handle-test-error* suite-name test-name thunk) (call-with-current-continuation (lambda (k) (with-handler (lambda (condition next) (set! *test-failures* (cons (list suite-name test-name condition) *test-failures*)) (k '())) thunk))))

(define-syntax with-handle-test-error (syntax-rules () ((with-handle-test-error ?suite-name ?test-name ?body ...) (with-handle-test-error* ?suite-name ?test-name (lambda () ?body ...)))))

(define (display-failures test-failures) (for-each (lambda (failure) (display "FAILURE: ") (display failure) (newline)) test-failures))

(define (run-tests) (set! *test-failures* '()) (for-each (lambda (suite) (run-test-suite (car suite))) *tests*) (display-failures *test-failures*))

(define (run-test-suite suite-name) (let ((suite (assq suite-name *tests*))) (if (not suite) (error "Suite " suite-name "not defined")) (for-each (lambda (tst) (with-handle-test-error suite-name (car tst) (run-test suite-name (car tst))))

(test-thunks suite-name))))

(define (run-test suite-name test-name) (dynamic-wind (setup-thunk suite-name) (find-test-by-name suite-name test-name 'test-not-found) (teardown-thunk suite-name)))

Here's a little example:

 (define-tests arithmetic-tests 
	((a 5) (b 6))
	(setup (display "SETUP"))
	(teardown (display "TEARDOWN"))
	(assert (= (+ 2 3) 5))
	(assert (= (+ 2 2) 5)))
	(assert (= (* 2 4) 7))))

The bindings are fresh in each test:

 (define (writeln . args)
   (for-each display args)

(define-tests arithmatic-tests ((a 5) (b 6)) (test-addition (assert (= (+ 2 3) (begin (writeln "a: " a ", b: " b) a))) (assert (= (+ 2 3) (begin (set! a 4) (set! b 7) 5))) (assert (= (+ 2 2) (begin (writeln "a: " a ", b: " b) a)))) (test-multiplication (assert (= (* 2 4) (begin (writeln "a: " a ", b: " b) (+ b 1))))))

;; should return: ;; a: 5, b: 6 ;; a: 4, b: 7 ;; a: 5, b: 6 ;; FAILURE: (arithmatic-tests test-multiplication (error Assertion failed (= (* 2 4) (begin (writeln a: a , b: b) (+ b 1)))))

ChickenScheme comes with a unit testing framework.

SRFI 64 proposes "A Scheme API for test suites".

SRFI 78 -- "Lightweight testing".

Testeez is a simple test case mechanism for R5RS Scheme. It was written to support regression test suites embedded in the author's one-file-per-library Scheme libraries.
See Also LispMeUnit


View edit of January 3, 2008 or FindPage with title or text search