projects
/
fiveam.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
d714090
)
Added :fixture argument to TEST macro
author
Marco Baringer
<mb@bese.it>
Fri, 23 Mar 2007 19:41:33 +0000
(20:41 +0100)
committer
Marco Baringer
<mb@bese.it>
Fri, 23 Mar 2007 19:41:33 +0000
(20:41 +0100)
src/test.lisp
patch
|
blob
|
history
diff --git
a/src/test.lisp
b/src/test.lisp
index
b6e85db
..
33fa7c8
100644
(file)
--- a/
src/test.lisp
+++ b/
src/test.lisp
@@
-24,7
+24,7
@@
"Create a test named NAME. If NAME is a list it must be of the
form:
"Create a test named NAME. If NAME is a list it must be of the
form:
- (name &key depends-on suite)
+ (name &key depends-on suite fixture compile-at)
NAME is the symbol which names the test.
NAME is the symbol which names the test.
@@
-45,24
+45,33
@@
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.
,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) (compile-at :run-time))
+SUITE defaults to the current value of *SUITE*.
+
+FIXTURE specifies a fixtrue to wrap the body in."
+ (destructuring-bind (name &key depends-on (suite nil suite-supplied-p)
+ (compile-at :run-time) fixture)
(ensure-list name)
(declare (type (member :run-time :definition-time) compile-at))
(ensure-list name)
(declare (type (member :run-time :definition-time) compile-at))
- (let (description)
- (setf description (if (stringp (car body))
- (pop body)
- ""))
+ (let ((description (if (stringp (car body))
+ (pop body)
+ ""))
+ (effective-body (if fixture
+ (destructuring-bind (name &rest args)
+ (ensure-list fixture)
+ `((with-fixture ,name ,args ,@body)))
+ body)))
`(progn
(setf (get-test ',name) (make-instance 'test-case
:name ',name
:runtime-package ,*package*
:test-lambda
(lambda ()
`(progn
(setf (get-test ',name) (make-instance 'test-case
:name ',name
:runtime-package ,*package*
:test-lambda
(lambda ()
- ,@(ecase compile-at
- (:run-time `((funcall (let ((*package* ,*package*))
- (compile nil '(lambda () ,@body))))))
- (:definition-time body)))
+ ,@ (ecase compile-at
+ (:run-time `((funcall
+ (let ((*package* (find-package ',(package-name *package*))))
+ (compile nil '(lambda ()
+ ,@effective-body))))))
+ (:definition-time effective-body)))
:description ,description
:depends-on ',depends-on))
,(if suite-supplied-p
:description ,description
:depends-on ',depends-on))
,(if suite-supplied-p