Macro: TEST

Documentation

Create a suite named NAME. If NAME is a list it must be of the form: (name &key depends-on suite) NAME is the symbol which names the test. DEPENDS-ON is a list of the form: (AND . test-names) - This test is run only if all of the tests in TEST-NAMES have passed, otherwise a single test-skipped result is generated. (OR . test-names) - If any of TEST-NAMES has passed this test is run, otherwise a test-skipped result is generated. (NOT test-name) - This is test is run only if TEST-NAME failed. AND, OR and NOT can be combined to produce complex dependencies. If DEPENDS-ON is a symbol it is interpreted as `(AND ,depends-on), this is accomadate the common case of one test depending on another. SUITE defaults to the current value of *SUITE*.

Source

(defmacro test (name &body body)
  "Create a suite named NAME. If NAME is a list it must be of the
form:

  (name &key depends-on suite)

NAME is the symbol which names the test.

DEPENDS-ON is a list of the form:

 (AND . test-names) - This test is run only if all of the tests
 in TEST-NAMES have passed, otherwise a single test-skipped
 result is generated.

 (OR . test-names) - If any of TEST-NAMES has passed this test is
 run, otherwise a test-skipped result is generated.

 (NOT test-name) - This is test is run only if TEST-NAME failed.

AND, OR and NOT can be combined to produce complex dependencies.

If DEPENDS-ON is a symbol it is interpreted as `(AND
,depends-on), this is accomadate the common case of one test
depending on another.

SUITE defaults to the current value of *SUITE*."
  (destructuring-bind (name &key depends-on (suite nil suite-supplied-p))
      (ensure-list name)
    (let (lambda description)
      (setf description (if (stringp (car body))
			    (pop body)
			    "")
	    lambda body)
      `(progn
	 (setf (get-test ',name)
	       (make-instance 'test-case
			      :name ',name
			      :test-lambda (lambda () ,@lambda)
			      :description ,description
			      :depends-on ',depends-on))
	 ,(if suite-supplied-p
	      `(setf (gethash ',name (tests (get-test ',suite)))
		     ',name)
	      `(setf (gethash ',name (tests (or *suite* (get-test 'NIL))))
		     ',name))
	 ',name))))