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: 1295 bytes --]

On Tue, 2023-01-31 at 09:34 -0500, Stefan Monnier wrote:
> > > > Ah, right. Theother way I could think of a fix is setq-ing
> > > > `form`
> > > > to a
> > > > shallow copy of the original form, with only the place(s)
> > > > changed.
> > > > This
> > > > patch tries to do that by using `pcase-let` to destructure
> > > > forms.
> > > 
> > > Hmm... yes, that's closer.  It's pretty ugly, tho.
> > > Yet it's hard to make it less ugly here because the
> > > `cconv-freevars-alist` really depends on `eq` equality.
> > > 
> > > Maybe we should pass `cif` to `cconv--convert-function` (or maybe
> > > even
> > > move most of that `cconv--interactive-form-funs`-handling to that
> > > function) and arrange for that function to do the
> > > "non-side-effecting-equivalent-of" (setf (cadr (car bf)) form)?
> > > 
> > > 
> > >         Stefan
> > > 
> > 
> > I tried to shift the `cif` related bits to `cconc--convert-
> > function`,
> > but my understanding of cconv.el isn't that great, so I wasn't
> > successful at doing that :( Should I add a TODO to the change for
> > the
> > future?
> 
> Yes, please,
> 
> 
>         Stefan
> 

Done, thoughts?

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

[-- Attachment #1.2: 60974-3.patch --]
[-- Type: text/x-patch, Size: 2591 bytes --]

diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index e715bd90a00..5a6ae798c93 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -477,20 +477,40 @@ 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))
             (if (when (eq 'interactive (car-safe (car bf)))
                   (gethash form cconv--interactive-form-funs)))
             (cif (when if (cconv-convert if env extend)))
-            (_ (pcase cif
-                 (`#'(lambda () ,form) (setf (cadr (car bf)) form) (setq cif nil))
-                 ('nil 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
+         (`#'(lambda () ,form)
+          (pcase-let ((`((,f1 . (,_ . ,f2)) . ,f3) bf))
+            (setq bf `((,f1 . (,form . ,f2)) . ,f3)))
+          (setq cif nil))
+         ('nil (setq bf 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

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