[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 1e5393a57a3: Don't modify interactive closures destructively (Bug
From: |
Vibhav Pant |
Subject: |
master 1e5393a57a3: Don't modify interactive closures destructively (Bug#60974). |
Date: |
Mon, 6 Mar 2023 09:59:04 -0500 (EST) |
branch: master
commit 1e5393a57a3bbe3f9167fee59232c2e424afadf2
Author: Vibhav Pant <vibhavp@gmail.com>
Commit: Vibhav Pant <vibhavp@gmail.com>
Don't modify interactive closures destructively (Bug#60974).
* lisp/emacs-lisp/cconv.el (cconv-convert): When form is an
interactive lambda form, don't destructively modify it, as it might be
a constant literal. Instead, create a new list with the relevant
place(s) changed.
* test/lisp/emacs-lisp/cconv-tests.el
(cconv-tests-interactive-form-modify-bug60974): New test.
---
lisp/emacs-lisp/cconv.el | 37 +++++++++++++++++++++++++++----------
test/lisp/emacs-lisp/cconv-tests.el | 12 ++++++++++++
2 files changed, 39 insertions(+), 10 deletions(-)
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index ad9d8ab0a51..601e2c13d61 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -477,7 +477,7 @@ places where they originally did not directly appear."
branch))
cond-forms)))
- (`(function (lambda ,args . ,body) . ,_)
+ (`(function (lambda ,args . ,body) . ,rest)
(let* ((docstring (if (eq :documentation (car-safe (car body)))
(cconv-convert (cadr (pop body)) env extend)))
(bf (if (stringp (car body)) (cdr body) body))
@@ -485,15 +485,32 @@ places where they originally did not directly appear."
(gethash form cconv--interactive-form-funs)))
(wrapped (pcase if (`#'(lambda (&rest _cconv--dummy) .,_) t) (_
nil)))
(cif (when if (cconv-convert if env extend)))
- (_ (pcase cif
- ('nil nil)
- (`#',f
- (setf (cadr (car bf)) (if wrapped (nth 2 f) cif))
- (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))))
- (cf (cconv--convert-function args body env form docstring)))
+ (cf nil))
+ ;; TODO: Because we need to non-destructively modify body, this code
+ ;; is particularly ugly. This should ideally be moved to
+ ;; cconv--convert-function.
+ (pcase cif
+ ('nil (setq bf nil))
+ (`#',f
+ (pcase-let ((`((,f1 . (,_ . ,f2)) . ,f3) bf))
+ (setq bf `((,f1 . (,(if wrapped (nth 2 f) cif) . ,f2)) . ,f3)))
+ (setq cif nil))
+ ;; The interactive form needs special treatment, so the form
+ ;; inside the `interactive' won't be used any further.
+ (_ (pcase-let ((`((,f1 . (,_ . ,f2)) . ,f3) bf))
+ (setq bf `((,f1 . (nil . ,f2)) . ,f3)))))
+ (when bf
+ ;; If we modified bf, re-build body and form as
+ ;; copies with the modified bits.
+ (setq body (if (stringp (car body))
+ (cons (car body) bf)
+ bf)
+ form `(function (lambda ,args . ,body) . ,rest))
+ ;; Also, remove the current old entry on the alist, replacing
+ ;; it with the new one.
+ (let ((entry (pop cconv-freevars-alist)))
+ (push (cons body (cdr entry)) cconv-freevars-alist)))
+ (setq cf (cconv--convert-function args body env form docstring))
(if (not cif)
;; Normal case, the interactive form needs no special treatment.
cf
diff --git a/test/lisp/emacs-lisp/cconv-tests.el
b/test/lisp/emacs-lisp/cconv-tests.el
index 349ffeb7e47..6facd3452ea 100644
--- a/test/lisp/emacs-lisp/cconv-tests.el
+++ b/test/lisp/emacs-lisp/cconv-tests.el
@@ -376,6 +376,18 @@
(eval '(lambda (x) :closure-dont-trim-context (+ x 1))
`((y . ,magic-string)))))))
+(ert-deftest cconv-tests-interactive-form-modify-bug60974 ()
+ (let* ((f '(function (lambda (&optional arg)
+ (interactive
+ (list (if current-prefix-arg
+ (prefix-numeric-value current-prefix-arg)
+ 'toggle)))
+ (ignore arg))))
+ (if (cadr (nth 2 (cadr f))))
+ (if2))
+ (cconv-closure-convert f)
+ (setq if2 (cadr (nth 2 (cadr f))))
+ (should (eq if if2))))
(provide 'cconv-tests)
;;; cconv-tests.el ends here
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 1e5393a57a3: Don't modify interactive closures destructively (Bug#60974).,
Vibhav Pant <=