mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
Fix fasteval's error message for undefined (FUNCTION f) forms
It was saying that every undefined function is a macro.
This commit is contained in:
parent
6cc4129c11
commit
193f2659f3
|
|
@ -1143,28 +1143,27 @@
|
|||
(if (and (listp name) (memq (car name) '(named-lambda lambda)))
|
||||
(handler (if (must-freeze-p env) #'enclose-freeze #'enclose)
|
||||
(make-proto-fn name))
|
||||
(multiple-value-bind (kind definition frame-ptr)
|
||||
(find-lexical-fun env name)
|
||||
(binding* (((kind definition frame-ptr) (find-lexical-fun env name))
|
||||
(fdefn (unless definition (find-or-create-fdefn name))))
|
||||
(cond (definition ; lexical function
|
||||
(if (eq kind :macro)
|
||||
(not-a-function name)
|
||||
(hlambda FUNCTION (frame-ptr) (env)
|
||||
(local-fdefinition frame-ptr env))))
|
||||
;; Consider (DEFUN GET-THING () #'THING) - it shouldn't return
|
||||
;; THING's error trampoline if THING is redefined after
|
||||
;; GET-THING was called once.
|
||||
((symbolp name) ; could be a macro
|
||||
(hlambda FUNCTION (name) (env)
|
||||
(declare (ignore env))
|
||||
(let ((fun (%symbol-function name)))
|
||||
(if (or (not fun) (sb-impl::macro/special-guard-fun-p fun))
|
||||
(not-a-function name)
|
||||
fun))))
|
||||
(t
|
||||
(let ((fdefn (find-or-create-fdefn name)))
|
||||
(hlambda FUNCTION (fdefn) (env) ; could not be a macro
|
||||
(declare (ignore env))
|
||||
(sb-c:safe-fdefn-fun fdefn)))))))))
|
||||
;; Relying solely on SAFE-FDEFN-FUN here is not ideal
|
||||
;; because it can produce an error-signaling closure.
|
||||
(hlambda FUNCTION (fdefn) (env)
|
||||
(declare (ignore env))
|
||||
(let ((fun (sb-c:safe-fdefn-fun fdefn)))
|
||||
(if (sb-impl::macro/special-guard-fun-p fun)
|
||||
(not-a-function #+linkage-space fdefn
|
||||
#-linkage-space (fdefn-name fdefn))
|
||||
fun))))
|
||||
(t ; could not be a macro
|
||||
(hlambda FUNCTION (fdefn) (env)
|
||||
(declare (ignore env))
|
||||
(sb-c:safe-fdefn-fun fdefn))))))))
|
||||
|
||||
;;;; some extra handlers
|
||||
|
||||
|
|
|
|||
|
|
@ -342,3 +342,23 @@
|
|||
(assert (eql (f) 3))
|
||||
(assert (not (compiled-function-p #'f)))
|
||||
(assert (compiled-function-p #'fancypkg:mystruct-x)))
|
||||
|
||||
(defun try-an-undefined-function (x)
|
||||
(funcall (cond ((vectorp x) #'copy-seq) (t #'this-is-not-defined)) x))
|
||||
|
||||
(test-util:with-test (:name :right-error-message-for-non-function)
|
||||
(assert (search "The function COMMON-LISP-USER::THIS-IS-NOT-DEFINED is undefined."
|
||||
(handler-case (try-an-undefined-function 3)
|
||||
(undefined-function (c) (write-to-string c :escape nil)))))
|
||||
(defmacro this-is-not-defined (x) `(car ,x))
|
||||
(assert (search "THIS-IS-NOT-DEFINED is a macro."
|
||||
(handler-case (try-an-undefined-function 3)
|
||||
;; I don't know whether this should be UNDEFINED-FUNCTION
|
||||
;; and I don't care.
|
||||
(sb-int:simple-program-error (c) (write-to-string c :escape nil)))))
|
||||
;; Make it undefined again (perhaps the fact that it was a macro was cached)
|
||||
;; and observe that the error message reverts to the "undefined" message.
|
||||
(fmakunbound 'this-is-not-defined)
|
||||
(assert (search "The function COMMON-LISP-USER::THIS-IS-NOT-DEFINED is undefined."
|
||||
(handler-case (try-an-undefined-function 3)
|
||||
(undefined-function (c) (write-to-string c :escape nil))))))
|
||||
|
|
|
|||
Loading…
Reference in a new issue