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:
Douglas Katzman 2026-03-19 12:43:39 -04:00
parent 6cc4129c11
commit 193f2659f3
2 changed files with 35 additions and 16 deletions

View file

@ -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

View file

@ -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))))))