Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (defmacro with-replaced-function (fdef &rest body)
- (let ((oldf (gensym))
- (result (gensym))
- (name (car fdef))
- (args (cadr fdef))
- (rbody (cddr fdef)))
- `(let ((,oldf (symbol-function ',name)))
- (setf (symbol-function ',name) (lambda ,args ,@rbody))
- (let ((,result (progn ,@body)))
- (setf (symbol-function ',name) ,oldf)
- ,result))))
- (defmacro show (x)
- `(format t "~a --> ~a~%"
- ',x ,x))
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (defun foo (x y) (+ x y))
- (defun bar (x) (foo x (* x 2)))
- (show (bar 42))
- (show (with-replaced-function (foo (x y) (* x y))
- (bar 42)))
- (show (bar 42))
- > (defun b () 'original)
- B
- > (setf f #'b)
- #<Compiled-function B #xC2C1546>
- > (defun a () (funcall f))
- A
- > (a)
- ORIGINAL
- > (setf f #'(lambda () 'stub))
- #<Anonymous Function #xC2D990E>
- > (a)
- STUB
- > (setf f #'b)
- #<Compiled-function B #xC2C1546>
- > (a)
- ORIGINAL
- (defmacro with-fun (origfn mockfn &body body)
- `(let ((it ,origfn))
- (setf ,origfn ,mockfn)
- ,@body
- (setf ,origfn ,it)))
- (ql:quickload :mockingbird)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement