From c3ba3bc968894227fd936ffd777f94c100bdea7d Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Wed, 22 Nov 2006 22:35:28 +0000 Subject: [PATCH] 0.9.18.68: Living dangerously... ... fix the (function-lambda-expression #'gf) problem; ... add test cases. --- src/code/target-misc.lisp | 2 +- tests/interface.impure.lisp | 24 ++++++++++++++++++++++++ version.lisp-expr | 2 +- 3 files changed, 26 insertions(+), 2 deletions(-) diff --git a/src/code/target-misc.lisp b/src/code/target-misc.lisp index 9333563..feb1cf5 100644 --- a/src/code/target-misc.lisp +++ b/src/code/target-misc.lisp @@ -33,7 +33,7 @@ (values `(lambda ,lambda-list ,@body) t name))) (function - (let* ((fun (%simple-fun-self fun)) + (let* ((fun (%simple-fun-self (%fun-fun fun))) (name (%fun-name fun)) (code (sb!di::fun-code-header fun)) (info (sb!kernel:%code-debug-info code))) diff --git a/tests/interface.impure.lisp b/tests/interface.impure.lisp index 3c21d5f..60795ad 100644 --- a/tests/interface.impure.lisp +++ b/tests/interface.impure.lisp @@ -53,6 +53,30 @@ (disassemble 'disassemble-generic) (let ((fin (sb-mop:make-instance 'sb-mop:funcallable-standard-object))) (disassemble fin)) + +;;; while we're at it, much the same applies to +;;; FUNCTION-LAMBDA-EXPRESSION: +(defun fle-fun (x) x) +(function-lambda-expression #'fle-fun) + +(let ((x 1)) (defun fle-closure (y) (if y (setq x y) x))) +(function-lambda-expression #'fle-closure) + +#+sb-eval +(progn + ;; Nor should it fail on interpreted functions + (let ((sb-ext:*evaluator-mode* :interpret)) + (eval `(defun fle-eval (x) x)) + (function-lambda-expression #'fle-eval)) + + ;; fle-eval should still be an interpreted function. + (assert (sb-eval:interpreted-function-p #'fle-eval))) + +;; nor should it fail on generic functions or other funcallable instances +(defgeneric fle-generic (x)) +(function-lambda-expression #'fle-generic) +(let ((fin (sb-mop:make-instance 'sb-mop:funcallable-standard-object))) + (function-lambda-expression fin)) ;;; support for DESCRIBE tests (defstruct to-be-described a b) diff --git a/version.lisp-expr b/version.lisp-expr index bf0506e..e34c3f9 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.18.67" +"0.9.18.68" -- 1.7.10.4