summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp/cconv.el
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2023-02-04 11:23:31 -0500
committerStefan Monnier <monnier@iro.umontreal.ca>2023-02-04 11:23:31 -0500
commitc39c26e33f6bb45479bbd1a80df8c97cf750a56a (patch)
tree0632a99a1c20488637fc7fe108c30bab7e3d5055 /lisp/emacs-lisp/cconv.el
parent229d0772e235f51812ed8020a31f9a8de366c7ba (diff)
downloademacs-c39c26e33f6bb45479bbd1a80df8c97cf750a56a.tar.gz
emacs-c39c26e33f6bb45479bbd1a80df8c97cf750a56a.tar.bz2
emacs-c39c26e33f6bb45479bbd1a80df8c97cf750a56a.zip
nadvice: Fix bug#61179
Advising interactive forms relies on the ability to distinguish interactive forms that do nothing else than return a function. So, be careful to preserve this info. Furthermore, interactive forms are expected to be evaluated in the lexical context captured by the closure to which they belong, so be careful to preserve that context when manipulating those forms. * lisp/emacs-lisp/cconv.el (cconv-convert, cconv-analyze-form) <lambda>: Preserve the info that an interactive form does nothing else than return a function. * lisp/emacs-lisp/nadvice.el (advice--interactive-form-1): New function. (advice--interactive-form): Use it. (advice--make-interactive-form): Refine to also accept function values quoted with `quote`. Remove obsolete TODO. * test/lisp/emacs-lisp/nadvice-tests.el: Don't disallow byte-compilation. (advice-test-bug61179): New test. * lisp/emacs-lisp/oclosure.el (cconv--interactive-helper): Allow the `if` arg to be a form. * lisp/simple.el (oclosure-interactive-form): Adjust accordingly.
Diffstat (limited to 'lisp/emacs-lisp/cconv.el')
-rw-r--r--lisp/emacs-lisp/cconv.el11
1 files changed, 8 insertions, 3 deletions
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index e715bd90a00..e4268c2fb88 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -483,10 +483,13 @@ places where they originally did not directly appear."
(bf (if (stringp (car body)) (cdr body) body))
(if (when (eq 'interactive (car-safe (car bf)))
(gethash form cconv--interactive-form-funs)))
+ (wrapped (pcase if (`#'(lambda (_cconv--dummy) .,_) t) (_ nil)))
(cif (when if (cconv-convert if env extend)))
(_ (pcase cif
- (`#'(lambda () ,form) (setf (cadr (car bf)) form) (setq cif nil))
('nil nil)
+ (`#',f
+ (setf (cadr (car bf)) (if wrapped (nth 2 f) f))
+ (setq cif nil))
;; The interactive form needs special treatment, so the form
;; inside the `interactive' won't be used any further.
(_ (setf (cadr (car bf)) nil))))
@@ -494,7 +497,8 @@ places where they originally did not directly appear."
(if (not cif)
;; Normal case, the interactive form needs no special treatment.
cf
- `(cconv--interactive-helper ,cf ,cif))))
+ `(cconv--interactive-helper
+ ,cf ,(if wrapped cif `(list 'quote ,cif))))))
(`(internal-make-closure . ,_)
(byte-compile-report-error
@@ -742,7 +746,8 @@ This function does not return anything but instead fills the
(when (eq 'interactive (car-safe (car bf)))
(let ((if (cadr (car bf))))
(unless (macroexp-const-p if) ;Optimize this common case.
- (let ((f `#'(lambda () ,if)))
+ (let ((f (if (eq 'function (car-safe if)) if
+ `#'(lambda (_cconv--dummy) ,if))))
(setf (gethash form cconv--interactive-form-funs) f)
(cconv-analyze-form f env))))))
(cconv--analyze-function vrs body-forms env form))