bug#60974: 30.0.50; byte-compile-preprocess mutates self evaluating forms in expanded macro bodies

[Vibhav Pant <vibhavp@gmail.com>]

[-- Attachment #1.1: Type: text/plain, Size: 1001 bytes --]

On Thu, 2023-02-02 at 11:04 -0500, Stefan Monnier wrote:
> > Alternatively, we could define a macro, store its expanded form in
> > a
> > variable and run it through `cconv-closure-convert`, checking
> > afterwards whether the original value changed or not. It feels a
> > little
> > more reliable, but writing it might be a little tricky.
> 
> I was thinking of doing something like:
> 
>     (let ((f '(lambda () (interactive ...) ...)))
>       (should (equal f
>                      (let ((fc (copy-tree f)))
>                        (byte-compile fc)
>                        fc))))
> 
> 
> -- Stefan
> 

I wrote a variant of this that specifically calls `cconv-closure-
convert`, and checks if the interactive spec has been modified, using
`eq`. It fails on master, and passes with the patch installed.

-- 
Vibhav Pant
vibhavp@gmail.com
GPG: 7ED1 D48C 513C A024 BE3A  785F E3FB 28CB 6AB5 9598

[-- Attachment #1.2: 60974-tests.diff --]
[-- Type: text/x-patch, Size: 3585 bytes --]

diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index e8d639903c1..81f8d5ad362 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -477,7 +477,7 @@ cconv-convert
                                         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 @@ cconv-convert
                   (gethash form cconv--interactive-form-funs)))
             (wrapped (pcase if (`#'(lambda (_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 83013cf46a9..c72137e5d47 100644
--- a/test/lisp/emacs-lisp/cconv-tests.el
+++ b/test/lisp/emacs-lisp/cconv-tests.el
@@ -364,5 +364,18 @@ cconv-tests-interactive-closure-bug51695
                            (call-interactively f))
                      '((t 51696) (nil 51695) (t 51697)))))))
 
+(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

[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 488 bytes --]