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

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

[Vibhav Pant]

[-- Attachment #1: Type: text/plain, Size: 4295 bytes --]

`cconv-closure-convert`, called from `byte-compile-preprocess` calls
`setcar` on a self evaluating interactive form as part of the function
body. This can be reproduced by adding the following snippet to
`lisp/loadup.el`, and building Emacs:

```
(load "emacs-lisp/bytecomp")
(setq sample-interactive-spec
      (purecopy '(interactive
                  (list (if current-prefix-arg
                            (prefix-numeric-value 
                             current-prefix-arg)
                          'toggle)))))

(defmacro define-purecopied-func ()
  `(defun foo-bar (arg)
     ,sample-interactive-spec))

(let ((byte-compile-debug t))
  (byte-compile '(define-purecopied-func)))
```
(`purecopy` ensures mutating the list triggers a `pure_write_error`)

As mutating quoted/constant lists is undefined behaviour as per the
Elisp reference manual
(https://www.gnu.org/software/emacs/manual/html_node/elisp/Mutability.htm
),
the body returned by `macroexpand-all` should likely be copied using
`copy-tree`.

In GNU Emacs 30.0.50 (build 6, x86_64-pc-linux-gnu, GTK+ Version
 3.24.36, cairo version 1.17.6) of 2023-01-05 built on vibhavp-mbp
Repository revision: 15fc7b3cde92e420f48dfe188251e6af4d832af5
Repository branch: master
System Description: Arch Linux

Configured using:
 'configure --with-pgtk --with-sqlite3 --with-native-compilation=yes
 --with-all --without-compress-install --enable-link-time-optimization
 -C 'CFLAGS=-march=native -mtune=native -O3 -g3 -ggdb3 -gdwarf-5''

Configured features:
ACL CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GPM GSETTINGS HARFBUZZ JPEG
JSON LCMS2 LIBOTF LIBSYSTEMD LIBXML2 MODULES NATIVE_COMP NOTIFY INOTIFY
PDUMPER PGTK PNG RSVG SECCOMP SOUND SQLITE3 THREADS TIFF
TOOLKIT_SCROLL_BARS TREE_SITTER WEBP XIM GTK3 ZLIB

Important settings:
  value of $LANG: en_US.UTF-8
  locale-coding-system: utf-8-unix

Major mode: Lisp Interaction

Minor modes in effect:
  tooltip-mode: t
  global-eldoc-mode: t
  eldoc-mode: t
  show-paren-mode: t
  electric-indent-mode: t
  mouse-wheel-mode: t
  tool-bar-mode: t
  menu-bar-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  blink-cursor-mode: t
  line-number-mode: t
  indent-tabs-mode: t
  transient-mark-mode: (only . t)
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t

Load-path shadows:
None found.

Features:
(shadow sort mail-extr emacsbug message mailcap yank-media puny dired
dired-loaddefs rfc822 mml mml-sec password-cache epa derived epg
rfc6068
epg-config gnus-util text-property-search time-date mm-decode mm-bodies
mm-encode mail-parse rfc2231 mailabbrev gmm-utils mailheader cl-
loaddefs
comp comp-cstr warnings icons subr-x rx cl-seq cl-macs gv cl-extra
help-mode bytecomp byte-compile cl-lib sendmail rfc2047 rfc2045
ietf-drums mm-util mail-prsvr mail-utils rmc iso-transl tooltip cconv
eldoc paren electric uniquify ediff-hook vc-hooks lisp-float-type
elisp-mode mwheel term/pgtk-win pgtk-win term/common-win pgtk-dnd
tool-bar dnd fontset image regexp-opt fringe tabulated-list replace
newcomment text-mode lisp-mode prog-mode register page tab-bar menu-bar
rfn-eshadow isearch easymenu timer select scroll-bar mouse jit-lock
font-lock syntax font-core term/tty-colors frame minibuffer nadvice seq
simple cl-generic indonesian philippine cham georgian utf-8-lang
misc-lang vietnamese tibetan thai tai-viet lao korean japanese eucjp-ms
cp51932 hebrew greek romanian slovak czech european ethiopic indian
cyrillic chinese composite emoji-zwj charscript charprop case-table
epa-hook jka-cmpr-hook help abbrev obarray oclosure cl-preloaded button
loaddefs theme-loaddefs faces cus-face macroexp files window
text-properties overlay sha1 md5 base64 format env code-pages mule
custom widget keymap hashtable-print-readable backquote threads
dbusbind
inotify dynamic-setting system-font-setting font-render-setting cairo
gtk pgtk lcms2 multi-tty make-network-process native-compile emacs)

Memory information:
((conses 16 78180 10230)
 (symbols 48 7127 0)
 (strings 32 19480 1383)
 (string-bytes 1 595292)
 (vectors 16 16343)
 (vector-slots 8 326128 14214)
 (floats 8 28 51)
 (intervals 56 237 0)
 (buffers 984 11))

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

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

[Vibhav Pant]

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

The attached patch should fix this, thoughts?

Best,
Vibhav

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

[-- Attachment #1.2: Type: text/x-patch, Size: 744 bytes --]

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index aa9521e5a65..847965e6af6 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2581,7 +2581,8 @@ byte-compile-flush-pending
 
 (defun byte-compile-preprocess (form &optional _for-effect)
   (let ((print-symbols-bare t))         ; Possibly redundant binding.
-    (setq form (macroexpand-all form byte-compile-macro-environment)))
+    (setq form (copy-tree
+                (macroexpand-all form byte-compile-macro-environment))))
   ;; FIXME: We should run byte-optimize-form here, but it currently does not
   ;; recurse through all the code, so we'd have to fix this first.
   ;; Maybe a good fix would be to merge byte-optimize-form into

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

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

[Vibhav Pant]

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

The attached patch should fix this, thoughts?

Thanks,
Vibhav

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

[-- Attachment #1.2: Type: text/x-patch, Size: 744 bytes --]

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index aa9521e5a65..847965e6af6 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2581,7 +2581,8 @@ byte-compile-flush-pending
 
 (defun byte-compile-preprocess (form &optional _for-effect)
   (let ((print-symbols-bare t))         ; Possibly redundant binding.
-    (setq form (macroexpand-all form byte-compile-macro-environment)))
+    (setq form (copy-tree
+                (macroexpand-all form byte-compile-macro-environment))))
   ;; FIXME: We should run byte-optimize-form here, but it currently does not
   ;; recurse through all the code, so we'd have to fix this first.
   ;; Maybe a good fix would be to merge byte-optimize-form into

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

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

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

> The attached patch should fix this, thoughts?

It's not really an option:
- it's expensive
- it breaks code when it doesn't form a tree, e.g.

      (list '#1=(a b #1#) 'c 'd)

Instead, we need to find out where in the code we perform the
side effect and change just that part.


        Stefan

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

[Vibhav Pant]

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

On Sat, 2023-01-21 at 00:43 -0500, Stefan Monnier wrote:
> > The attached patch should fix this, thoughts?
> 
> It's not really an option:
> - it's expensive
> - it breaks code when it doesn't form a tree, e.g.
> 
>       (list '#1=(a b #1#) 'c 'd)
> 
> Instead, we need to find out where in the code we perform the
> side effect and change just that part.
> 
> 
>         Stefan
> 

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.
 

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

[-- Attachment #1.2: Type: text/x-patch, Size: 2412 bytes --]

diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index e715bd90a00..f6160a13579 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -477,20 +477,37 @@ 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))
+       (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 --]

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

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

> 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

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

[Vibhav Pant]

[-- Attachment #1: Type: text/plain, Size: 1086 bytes --]

On Sat, 2023-01-28 at 18:10 -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?

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

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

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

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

>> > 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

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

[Vibhav Pant]

[-- 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 --]

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

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

>> Yes, please,
> Done, thoughts?

I think we can go with that for now.  I'll try to fix the todo at some
point, but I'm short on time for now,


        Stefan

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

[Vibhav Pant]

[-- Attachment #1: Type: text/plain, Size: 508 bytes --]

On Wed, 2023-02-01 at 09:33 -0500, Stefan Monnier wrote:
> > > Yes, please,
> > Done, thoughts?
> 
> I think we can go with that for now.  I'll try to fix the todo at
> some
> point, but I'm short on time for now,
> 
> 
>         Stefan
> 

Sure. Do we need to install this to the release branch? The bug doesn't
really break anything AFAIK, so I dont think it's really a release
blocker.

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

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

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

[Mattias Engdegård]

[ trimmed emacs-devel ]

2 feb. 2023 kl. 13.35 skrev Vibhav Pant <vibhavp@gmail.com>:

> Sure. Do we need to install this to the release branch? The bug doesn't
> really break anything AFAIK, so I dont think it's really a release
> blocker.

In any case there should be a test. (Not implying that you needed to be reminded, of course.)

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

[Vibhav Pant]

[-- Attachment #1: Type: text/plain, Size: 1325 bytes --]

On Thu, 2023-02-02 at 13:39 +0100, Mattias Engdegård wrote:
> [ trimmed emacs-devel ]
> 
> 2 feb. 2023 kl. 13.35 skrev Vibhav Pant <vibhavp@gmail.com>:
> 
> > Sure. Do we need to install this to the release branch? The bug
> > doesn't
> > really break anything AFAIK, so I dont think it's really a release
> > blocker.
> 
> In any case there should be a test. (Not implying that you needed to
> be reminded, of course.)
> 

I had thought of adding a test a while back, but I'm not sure how we'd
do it. The immutability of self evaluating literals is only enforced
for data in purespace. One potential way to achieve this would be a
test-case that depends on a macro defined in purespace, which expands
to a body that is not byte-compiled, but that doesn't sound like a
great approach.

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.

(Shameless plug for scratch/comp-static-data, which does enforce
immutability in natively compiled code, and has new tests that check
for exactly this).

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

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

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

[Eli Zaretskii]

> From: Vibhav Pant <vibhavp@gmail.com>
> Cc: 60974@debbugs.gnu.org, emacs-devel <emacs-devel@gnu.org>
> Date: Thu, 02 Feb 2023 18:05:13 +0530
> 
> Sure. Do we need to install this to the release branch? The bug doesn't
> really break anything AFAIK, so I dont think it's really a release
> blocker.

In that case, please don't install on the release branch.

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

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

> 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

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

[Vibhav Pant]

[-- 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 --]