-If PROFILE is T profiling information will be collected as well."
- (let ((suite-form
- (if suite-p
- `(get-test ',suite)
- (or suite '*suite*))))
- (check-type compile-at (member :run-time :definition-time))
- (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))
- (lambda-name
- (format-symbol t "%~A-~A" '#:test name))
- (inner-lambda-name
- (format-symbol t "%~A-~A" '#:inner-test name)))
+If PROFILE is T profiling information will be collected as well.
+
+COMPILE-AT can be either :RUN-TIME, in which case compilation of the
+test code will be delayed until the test is run, or :DEFINITION-TIME,
+in which case the code will be compiled when the DEF-TEST form itself
+is compiled."
+ (check-type compile-at (member :run-time :definition-time))
+ (multiple-value-bind (forms decls docstring)
+ (parse-body body :documentation t :whole name)
+ (let* ((description (or docstring ""))
+ (body-forms (append decls forms))
+ (suite-form (if suite-p
+ (if suite
+ `(get-test ',suite)
+ nil)
+ '*suite*))
+ (effective-body (let* ((test-fixture fixture)
+ (suite-fixture (if suite-p
+ (if suite
+ (fixture (get-test suite :error t))
+ nil)
+ (if *suite*
+ (fixture *suite*)
+ nil)))
+ (effective-fixture (or test-fixture suite-fixture)))
+ (if effective-fixture
+ (destructuring-bind (name &rest args)
+ (ensure-list effective-fixture)
+ `((with-fixture ,name ,args ,@body-forms)))
+ body-forms))))