From ad0067a9e11dd8937dcc6b2d7e503511341d4608 Mon Sep 17 00:00:00 2001 From: Douglas Katzman Date: Mon, 30 Jun 2025 03:07:51 +0000 Subject: [PATCH] Accept a non-FBOUNDP function in ENCAPSULATE Makes no difference to TRACE (the predominant use of ENCAPSULATE) which checks for a defined function, but has other uses as explained. --- src/code/fdefinition.lisp | 26 ++++++++++++++++++-------- tests/encap.impure.lisp | 33 +++++++++++++++++++++++++++++++++ 2 files changed, 51 insertions(+), 8 deletions(-) diff --git a/src/code/fdefinition.lisp b/src/code/fdefinition.lisp index 256d98fe3..8b5ab06b3 100644 --- a/src/code/fdefinition.lisp +++ b/src/code/fdefinition.lisp @@ -250,16 +250,25 @@ ;;; otherwise the new encapsulation goes to the front of the chain. (defun encapsulate (name type function) (let ((underlying-fun (name->fun name))) - (when (macro/special-guard-fun-p underlying-fun) + ;; No error is signaled when encapsulating a nonexistent function, however + ;; the wrapper will receive as its first arg a function that signals an error. + (when (or (and underlying-fun (macro/special-guard-fun-p underlying-fun)) + (not name)) (error "~S can not be encapsulated" name)) (when (typep underlying-fun 'generic-function) (return-from encapsulate (encapsulate-generic-function underlying-fun type function))) (multiple-value-bind (existing predecessor) (has-encap underlying-fun type) ;; If TYPE existed, the new DEFINITION comes from the existing - (when existing - (setf underlying-fun (encapsulation-info-definition existing))) - (let* ((info (make-encapsulation-info type underlying-fun)) + (let* ((info (if (not existing) + (make-encapsulation-info + type + (or underlying-fun + (lambda (&rest args) + (declare (sb-c::lambda-list ($undef$))) + (declare (ignore args)) + (error "~S is undefined" name)))) + (copy-structure existing))) (specialized-xep (info :function :specialized-xep name)) (closure (named-lambda encapsulation (&rest args) (apply function (encapsulation-info-definition info) @@ -286,10 +295,11 @@ (when existing (let* ((next (encapsulation-info-definition existing)) (specialized-xep (encapsulation-info-specialized-xep existing))) - (if predecessor - (setf (encapsulation-info-definition predecessor) next) - ;; It's the first one, so change the fdefn object. - (fset name next)) + (cond (predecessor + (setf (encapsulation-info-definition predecessor) next)) + ;; It's the first one, so change the fdefn object. + ((equal (%fun-lambda-list next) '($undef$)) (fmakunbound name)) + (t (fset name next))) (when specialized-xep (fset (%fun-name specialized-xep) specialized-xep))))))))) diff --git a/tests/encap.impure.lisp b/tests/encap.impure.lisp index c6e381378..3b00a8ba6 100644 --- a/tests/encap.impure.lisp +++ b/tests/encap.impure.lisp @@ -59,3 +59,36 @@ (sb-int:encapsulate 'thing 'encap.a (lambda (realfun arg) (cons :new-a (funcall realfun arg)))) (assert (equal (thing :x) '(:new-a :b :c "D" :hi :x)))) + +;;; Check that ENCAPSULATE on an undefined functions works, and that +;;; UNENCAPSULATE can make it undefined. The use-case it to allow test-related +;;; mocks to be agnostic of whether a required function in two loosely coupled +;;; modules exists. e.g. module A calls into module B, and A expects that B exposes +;;; a certain global function F. You would like to unit-test A and B separately +;;; and together. To test together, can mock (via encapsulation) F to observe +;;; inputs and outputs of the interface. To test A alone, you can similarly mock F +;;; despite that it had no global definition, as B is not loaded. +;;; This feature of encapsulate is strictly more useful than just erring when a +;;; function to be encapsulated has no global definition. +(with-test (:name :encapsulate-undef) + (sb-int:encapsulate 'this-function-is-not-defined 'testing + (lambda (realfun) (declare (ignore realfun)) 'ok)) + (assert (eq (funcall 'this-function-is-not-defined) 'ok)) + (sb-int:unencapsulate 'this-function-is-not-defined 'testing) + (assert (not (fboundp 'this-function-is-not-defined))) + ;; furthermore, it works to create two encapsulations on the + ;; undefined function, and regardless of which order the + ;; encapsulations are stripped off, the function becomes undefined. + (assert (not (fboundp 'beeboh))) + (sb-int:encapsulate 'beeboh 'inner (lambda (realfun) realfun 'this-is-inner)) + (sb-int:encapsulate 'beeboh 'outer (lambda (realfun) realfun 'this-is-outer)) + (sb-int:unencapsulate 'beeboh 'outer) + (eq (funcall 'beeboh) 'this-is-inner) + (sb-int:unencapsulate 'beeboh 'inner) + (assert (not (fboundp 'beeboh))) + (sb-int:encapsulate 'beeboh 'inner (lambda (realfun) realfun 'this-is-inner)) + (sb-int:encapsulate 'beeboh 'outer (lambda (realfun) realfun 'this-is-outer)) + (sb-int:unencapsulate 'beeboh 'inner) + (eq (funcall 'beeboh) 'this-is-outer) + (sb-int:unencapsulate 'beeboh 'outer) + (assert (not (fboundp 'beeboh))))