From 182c5bd0c2c800f35f70ef2513d8e8a4e031310a Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Mon, 16 Sep 2013 10:01:23 -0400
Subject: [PATCH] Fix lp#1225898: ENSURE-FUNCTION must specially treat LAMBDA.

---
 ...test-around-compile-lambda.script.dont-run | 12 ---------
 test/test-around-compile.script               | 27 ++++++++++++-------
 uiop/utility.lisp                             |  7 +++--
 3 files changed, 23 insertions(+), 23 deletions(-)
 delete mode 100644 test/test-around-compile-lambda.script.dont-run

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 767a94d5..00000000
--- 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 babd00e3..33e8fcac 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 ab0b99c7..685859bf 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))))))))
-- 
GitLab