/[cl-cli-parser]/cl-cli-parser/unit-test.lisp
ViewVC logotype

Contents of /cl-cli-parser/unit-test.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (show annotations)
Fri Jul 29 21:27:03 2005 UTC (8 years, 8 months ago) by dbueno
Branch: MAIN
CVS Tags: HEAD
Changes since 1.3: +9 -2 lines
- cli-parser.lisp: pretty-printing for CLI-OPTION, various code cleanups.

- cli-parser-test.lisp: Example option configuration.

- unit-test.lisp: (get-tests): New function.
1 (in-package :cl-user)
2
3 (defpackage :lunit
4 (:use :cl)
5 (:export #:deftest #:check #:get-tests))
6 (in-package :lunit)
7
8 ;;; from peter seibel's book, practical common lisp
9 ;;; www.gigamonkeys.com/book
10
11 (defmacro with-gensyms ((&rest syms) &body body)
12 `(let ,(loop for sym in syms collect `(,sym (gensym ,(symbol-name sym))))
13 ,@body))
14
15 (defvar *test-name* nil)
16
17 (defmacro deftest (name parameters &body body)
18 "Define a test function. Within a test function we can call
19 other test functions or use `check' to run individual test
20 cases."
21 `(defun ,name ,parameters
22 (let ((*test-name* (append *test-name* (list ',name))))
23 (macrolet ((check (&body forms)
24 `(combine-results
25 ,@(loop for f in forms collect `(report-result ,f ',f)))))
26 ,@body))))
27
28 (defmacro combine-results (&body forms)
29 "Combine the results (as booleans) of evaluating `forms' in order."
30 (with-gensyms (result)
31 `(let ((,result t))
32 ,@(loop for f in forms collect `(unless ,f (setf ,result nil)))
33 ,result)))
34
35 (defun report-result (result form)
36 "Report the results of a single test case. Called by `check'."
37 (format t "~:[FAIL~;pass~] ... ~a: ~w~%" result *test-name* form)
38 result)
39
40 (defun get-tests (&optional (p *package*))
41 "Get a list of the symbols corresponding to unit test functions
42 from the package P."
43 (loop for x being the symbols of p
44 if (eql 0 (search "test-" (symbol-name x) :test #'string-equal))
45 collect x))

  ViewVC Help
Powered by ViewVC 1.1.5