/[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 - (hide 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 dbueno 1.1 (in-package :cl-user)
2    
3     (defpackage :lunit
4     (:use :cl)
5 dbueno 1.4 (:export #:deftest #:check #:get-tests))
6 dbueno 1.1 (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 dbueno 1.3 (format t "~:[FAIL~;pass~] ... ~a: ~w~%" result *test-name* form)
38 dbueno 1.4 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