diff --git a/test/test-around-compile-lambda.script.dont-run b/test/test-around-compile-lambda.script.dont-run deleted file mode 100644 index 767a94d5d1a2226dbef596cc0826108f90abee84..0000000000000000000000000000000000000000 --- a/test/test-around-compile-lambda.script.dont-run +++ /dev/null @@ -1,12 +0,0 @@ -;;; -*- Lisp -*- - - -(progn - (def-test-system test-around-compile-lambda - :around-compile (lambda (thunk) - (let ((*read-base* 2)) - (funcall thunk))) - ;; :depends-on ((:version :asdf "2.017.18")) ; no :around-compile before that. - :components ((:file "test"))) - (load-system 'test-around-compile-lambda :force t) - (assert (= 3 (funcall 'add10 1)))) ;; add10 must have been compiled in base 2 diff --git a/test/test-around-compile.script b/test/test-around-compile.script index babd00e304dabede8d6e3a480ef539c54680b528..33e8fcac76b5fc4eba4ed2d3e15345ef670261e0 100644 --- a/test/test-around-compile.script +++ b/test/test-around-compile.script @@ -1,15 +1,24 @@ ;;; -*- Lisp -*- - - (defun call-in-base-2 (thunk) (let ((*read-base* 2)) (funcall thunk))) -(progn - (def-test-system test-around-compile - :around-compile call-in-base-2 - ;; :depends-on ((:version :asdf "2.017.18")) ; no :around-compile before that. - :components ((:file "test"))) - (load-system 'test-around-compile :force t) - (assert (= 3 (funcall 'add10 1)))) ;; add10 must have been compiled in base 2 +(DBG "Testing around-compile with a function name") +(def-test-system test-around-compile + :around-compile call-in-base-2 + ;; :depends-on ((:version :asdf "2.017.18")) ; no :around-compile before that. + :components ((:file "test"))) +(load-system 'test-around-compile :force t) +(assert (= 3 (funcall 'add10 1))) ;; add10 must have been compiled in base 2 + +(fmakunbound 'add10) + +(DBG "Testing around-compile with a lambda") +(def-test-system test-around-compile-lambda + :around-compile (lambda (thunk) + (let ((*read-base* 2)) + (funcall thunk))) + :components ((:file "test"))) +(load-system 'test-around-compile-lambda :force t) +(assert (= 3 (funcall 'add10 1))) ;; add10 must have been compiled in base 2 diff --git a/uiop/utility.lisp b/uiop/utility.lisp index ab0b99c756396c95fe5336dc3c2def375476f89f..685859bf55debc6f1b3f3981307bb6ebec215851 100644 --- a/uiop/utility.lisp +++ b/uiop/utility.lisp @@ -318,14 +318,17 @@ If the FUN is a non-sequence literal constant, return constantly that, i.e. for a boolean keyword character number or pathname. Otherwise if FUN is a non-literally constant symbol, return its FDEFINITION. If FUN is a CONS, return the function that applies its CAR -to the appended list of the rest of its CDR and the arguments. +to the appended list of the rest of its CDR and the arguments, +unless the CAR is LAMBDA, in which case the expression is evaluated. If FUN is a string, READ a form from it in the specified PACKAGE (default: CL) and EVAL that in a (FUNCTION ...) context." (etypecase fun (function fun) ((or boolean keyword character number pathname) (constantly fun)) ((or function symbol) fun) - (cons #'(lambda (&rest args) (apply (car fun) (append (cdr fun) args)))) + (cons (if (eq 'lambda (car fun)) + (eval fun) + #'(lambda (&rest args) (apply (car fun) (append (cdr fun) args))))) (string (eval `(function ,(with-standard-io-syntax (let ((*package* (find-package package))) (read-from-string fun))))))))