Fix letf! sometimes losing letf binds

When expanding:

  (quiet! ...)

You'd expect (simplified for explanation):

  (letf! ((standard-output ...)
         ((symbol-function #'message) ...)
         ((symbol-function #'load-file) ...)
         ((symbol-function #'write-region) ...))
    ...)

But instead get:

  (letf! ((standard-output ...))
    ;; where'd the other binds go?
    ...)

This was due to data-loss caused by nreverse's destructive mutation of
the given bindings.

Also: silences byte-compiler complaining about unused bindings.
This commit is contained in:
Henrik Lissner 2020-05-14 22:32:03 -04:00
parent e7f04a3d87
commit 68709fe93a
No known key found for this signature in database
GPG key ID: 5F6C0EA160557395

View file

@ -210,7 +210,7 @@ the same name, for use with `funcall' or `apply'. ARGLIST and BODY are as in
(setq body (macroexp-progn body))
(when (memq (car bindings) '(defun defmacro))
(setq bindings (list bindings)))
(dolist (binding (nreverse bindings) body)
(dolist (binding (reverse bindings) (macroexpand body))
(let ((type (car binding))
(rest (cdr binding)))
(setq
@ -219,11 +219,12 @@ the same name, for use with `funcall' or `apply'. ARGLIST and BODY are as in
(`defun `(cl-letf* ((,(car rest) (symbol-function #',(car rest)))
((symbol-function #',(car rest))
(lambda ,(cadr rest) ,@(cddr rest))))
(ignore ,(car rest))
,body))
(_
(when (eq (car-safe type) 'function)
(setq type `(symbol-function ,type)))
`(cl-letf ((,type ,@rest)) ,body)))))))
(setq type (list 'symbol-function type)))
(list 'cl-letf (list (cons type rest)) body)))))))
(defmacro quiet! (&rest forms)
"Run FORMS without generating any output.