Note: This is taken from the Chicken Wiki, where a more recent version could be available.

Introduction

This is yet another framework for defining unit tests for the Scheme programming language (in particular, the Chicken implementation). Most testing frameworks require tests to be defined in their own files, tipically one file with tests per module; this one was created on the idea that the best location for test definitions is preceding the procedures they test.

Tests serve as documentation of the expectations of procedures, specially in unusual cases. The most natural location for documentation about a procedure is immediately before its definition, which is where most programmers will embbed comments describing it. By placing the tests in that location, they serve as examples of usage in common and unusual cases, which increases their value. Furthermore, placing tests adjacent to the procedures they test makes it less likely for a programmer to forget to update them when he changes the procedure tested.

Another design decision of this framework is to make tests part of the compiled program or library. Tests will typically require very little additional space in a binary, which we consider worth paying for the convenience of not having to build a separate binary and libraries for the purpose of testing a program. Of course, this doesn't mean the tests will always run —to run them, one will set the TESTS environment variable—, but they will be present in binaries and libraries. In other words, while it would be trivial to extend this framework to allow compilation without tests, we've purposefully decided not to do so.

A third important design decision we've taken is performing the evaluation of the tests only after all code has been loaded. Most testing frameworks will run the tests as soon as their definition is found; this one delays the evaluation until the run-tests procedure is called (which programs should do as part of their initialization). This allows testing of mutually recursive libraries.

Usage

To use this testing framework in your program or library, you should use the test macro once per test. It takes as arguments:

Here are a few examples:

(test (list? (list 1 2 3)))

(test (string-split "a:b:c" ":")
      (list "a" "b" "c"))

(test (stream-filter even? (stream 1 2 3 4 5))
      (stream 2 4)
      (cut stream= char=? <...>))

Related tests should be grouped using the test-group macro. The macro expects a name for the group of tests to be followed by the actual tests. An example is provided below. Typically the name will be the name of the procedure tested. The use of test-group is optional.

Defining tests doesn't do anything by itself: at some point you have to call the run-tests procedure. This will cause the tests to be executed if the TESTS environment variable is set. If the TESTS_VERBOSE variable is set, information about each test will be printed. You should call the run-tests procedure when all your modules have been loaded and your environment is ready for the execution of your program.

You can control which tests to run by setting the TESTS_GROUPS variable to a list of the groups of tests that you want to run.

Example

Here is an example of a full program, with some tests:

(use embedded-test)

(test-group square
  (test (square 0) 0)
  (test (square 1) 1)
  (test (square 5) 25))

(define (square x) (* x x))

(test-group fact
  (test (fact 0) 1)
  (test (fact 1) 1)
  (test (fact 5) (* 5 4 3 2 1)))

(define (fact x)
  (if (= x 0)
    x
    (* x (fact (- x 1)))))

(run-tests)

(display (fact (square (read))))
(newline)

Running the above program with the TESTS environment variable set will produce the following output and abort the execution, showing that some of the tests failed due to the bug in the fact procedure:

Test from group fact failed: (fact 0)
Expected: 1
Received: 0

Test from group fact failed: (fact 1)
Expected: 1
Received: 0

Test from group fact failed: (fact 5)
Expected: 120
Received: 0

Error: Unit tests failed

License

This code is available under the GNU GPLv3 license.

Implementation

Runtime code

Dependencies

(use format-modular srfi-1)

Defining tests

We use a list to keep track of all tests defined so far:

(define *tests* '())

Unit tests are represented as a record:

(define-record test group-name name proc expect equal?)

The fields serve the following purpose:

group-name
If this test belongs to a group of tests, the name of the group. #f otherwise.
name
The name of the test, used for reporting failures.
proc
A procedure of one argument that evaluates the test expression. The argument is a procedure that, if called, will cause the test to fail.
expect
A procedure of no arguments that evaluates the expected result.
equal?
The comparison procedure, receiving the results of calling proc and expect and returning a boolean to indicate if they are the same.

Now a procedure for registering new tests:

(define (register-test . args)
  (set! *tests* (cons (apply make-test args) *tests*)))

Running tests

We create an internal procedure to run one test and return success or failure.

(define (run-test test)
  (when (getenv "TESTS_VERBOSE")
    (format (current-error-port) "Test~A: ~S..."
            (if (test-group-name test)
              (format #f " from group ~A" (test-group-name test))
              "")
            (test-name test)))
  (let* ((expect ((test-expect test)))
         (force-fail #f)
         (result (call-with-current-continuation
                   (lambda (return)
                     ((test-proc test)
                      (lambda args
                        (set! force-fail args)
                        (return (not expect)))))))
         (pass ((test-equal? test) result expect)))
    (when (getenv "TESTS_VERBOSE")
      (format (current-error-port) " ~A~%" (if pass "PASS" "FAIL")))
    (unless pass
      (format (current-error-port) "Test~A failed: ~S~%"
        (if (test-group-name test)
          (format #f " from group ~A" (test-group-name test))
          "")
        (test-name test))
      (if (list? force-fail)
        (format (current-error-port) "Aborted:~%~{~S~%~}~%" force-fail)
        (format (current-error-port) "Expected: ~S~%Received: ~S~%~%"
                expect
                result)))
    pass))

Based on that, we define the public run-tests procedure that evaluates all tests in the order in which they were defined and, if one or more fail, raises an error.

(define (run-tests)
  (when (getenv "TESTS_SHOW_GROUPS")
    (format (current-error-port) "Groups:~{ ~A~}~%"
            (delete-duplicates (map test-group-name (reverse *tests*)))))
  (when (and (getenv "TESTS")
             (positive?
               (count
                 (complement run-test)
                 (reverse
                   (filter
                     (let ((groups (map string->symbol
                                        (string-split
                                          (or (getenv "TESTS_GROUPS") "")
                                          " "))))
                       (if (null? groups)
                         identity
                         (compose (cut member <> groups)
                                  test-group-name)))
                     *tests*)))))
    (error "Unit tests failed")))

Macros

All that remains is creating the test and test-group macros. The former simply fills in the blanks and calls register-test. Note that the users should never pass the name or group parameters but let it be filled for them.

(define-macro (test expr . rest)
  (let-optionals rest ((expect #t)
                       (cmp? (if (null? rest)
                               '(lambda (a b) a)
                               'equal?))
                       (name expr)
                       (group #f))
    `(register-test ',group
                    ',name
                    (lambda (test-fail) ,expr)
                    (lambda () ,expect)
                    ,cmp?)))

The test-group macro simply modifies the internal (test ...) forms, filling the group, and returns them.

(define-macro (test-group group-name . rest)
  `(begin
     ,@(map
         (lambda (test)
           (let-optionals (cddr test) ((expect #t)
                                       (cmp? (if (null? rest)
                                               '(lambda (a b) a)
                                               'equal?))
                                       (name (cadr test)))
             `(test ,(cadr test) ,expect ,cmp? ,name ,group-name)))
         rest)))

Author

This was created by Alejandro Forero Cuervo.