Skip to content

Commit

Permalink
Revert "Compile test body normally if :COMPILE-AT is :DEFINITION-TIME"
Browse files Browse the repository at this point in the history
It broke several user seemingly because SBCL can't dump into a fasl
the result of a NAMED-LAMBDA.

This reverts commit cc23df4.
  • Loading branch information
sionescu committed Feb 18, 2018
1 parent 895687d commit b0cbe99
Showing 1 changed file with 24 additions and 26 deletions.
50 changes: 24 additions & 26 deletions src/test.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -103,37 +103,35 @@ If PROFILE is T profiling information will be collected as well."
(destructuring-bind (name &rest args)
(ensure-list fixture)
`((with-fixture ,name ,args ,@body-forms)))
body-forms))
(lambda-name
(format-symbol t "%~A-~A" '#:test name))
(inner-lambda-name
(format-symbol t "%~A-~A" '#:inner-test name))
(thunk `(named-lambda ,lambda-name ()
,@(ecase compile-at
(:run-time
`((funcall
(let ((*package* (find-package ',(package-name *package*))))
(compile ',inner-lambda-name
'(lambda () ,@effective-body))))))
(:definition-time
effective-body)))))
body-forms)))
`(progn
(register-test ',name ,description ,thunk ,suite-form ',depends-on ,profile)
(register-test ',name ,description ',effective-body ,suite-form ',depends-on ,compile-at ,profile)
(when *run-test-when-defined*
(run! ',name))
',name))))

(defun register-test (name description thunk suite depends-on profile)
(setf (get-test name)
(make-instance 'test-case
:name name
:runtime-package (find-package (package-name *package*))
:test-lambda thunk
:description description
:depends-on depends-on
:collect-profiling-info profile)
(gethash name (tests suite))
name))
(defun register-test (name description body suite depends-on compile-at profile)
(let ((lambda-name
(format-symbol t "%~A-~A" '#:test name))
(inner-lambda-name
(format-symbol t "%~A-~A" '#:inner-test name)))
(setf (get-test name)
(make-instance 'test-case
:name name
:runtime-package (find-package (package-name *package*))
:test-lambda
(eval
`(named-lambda ,lambda-name ()
,@(ecase compile-at
(:run-time `((funcall
(let ((*package* (find-package ',(package-name *package*))))
(compile ',inner-lambda-name
'(lambda () ,@body))))))
(:definition-time body))))
:description description
:depends-on depends-on
:collect-profiling-info profile))
(setf (gethash name (tests suite)) name)))

(defvar *run-test-when-defined* nil
"When non-NIL tests are run as soon as they are defined.")
Expand Down

0 comments on commit b0cbe99

Please sign in to comment.