Skip to content
Snippets Groups Projects
Commit 182c5bd0 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Fix lp#1225898: ENSURE-FUNCTION must specially treat LAMBDA.

parent 5b93d09a
No related branches found
No related tags found
No related merge requests found
;;; -*- 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
;;; -*- 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
......@@ -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))))))))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment