master c39c26e33f: nadvice: Fix bug#61179

[Stefan Monnier]

branch: master
commit c39c26e33f6bb45479bbd1a80df8c97cf750a56a
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    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.
---
 lisp/emacs-lisp/cconv.el              | 11 ++++++++---
 lisp/emacs-lisp/nadvice.el            | 30 ++++++++++++++++++++++++------
 lisp/emacs-lisp/oclosure.el           |  2 +-
 lisp/simple.el                        |  3 ++-
 test/lisp/emacs-lisp/nadvice-tests.el | 14 +++++++++++---
 5 files changed, 46 insertions(+), 14 deletions(-)

diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index e715bd90a0..e4268c2fb8 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))
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index 85934d9ed0..e457387acc 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -178,20 +178,38 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are 
expected.")
    ;; ((functionp spec) (funcall spec))
    (t (eval spec))))
 
+(defun advice--interactive-form-1 (function)
+  "Like `interactive-form' but preserves the static context if needed."
+  (let ((if (interactive-form function)))
+    (if (or (null if) (not (eq 'closure (car-safe function))))
+        if
+      (cl-assert (eq 'interactive (car if)))
+      (let ((form (cadr if)))
+        (if (macroexp-const-p form)
+            if
+          ;; The interactive is expected to be run in the static context
+          ;; that the function captured.
+          (let ((ctx (nth 1 function)))
+            `(interactive
+              ,(let* ((f (if (eq 'function (car-safe form)) (cadr form) form)))
+                 ;; If the form jut returns a function, preserve the fact that
+                 ;; it just returns a function, which is an info we use in
+                 ;; `advice--make-interactive-form'.
+                 (if (eq 'lambda (car-safe f))
+                     `',(eval form ctx)
+                   `(eval ',form ',ctx))))))))))
+
 (defun advice--interactive-form (function)
   "Like `interactive-form' but tries to avoid autoloading functions."
   (if (not (and (symbolp function) (autoloadp (indirect-function function))))
-      (interactive-form function)
+      (advice--interactive-form-1 function)
     (when (commandp function)
       `(interactive (advice-eval-interactive-spec
-                     (cadr (interactive-form ',function)))))))
+                     (cadr (advice--interactive-form-1 ',function)))))))
 
 (defun advice--make-interactive-form (iff ifm)
-  ;; TODO: make it so that interactive spec can be a constant which
-  ;; dynamically checks the advice--car/cdr to do its job.
-  ;; For that, advice-eval-interactive-spec needs to be more faithful.
   (let* ((fspec (cadr iff)))
-    (when (eq 'function (car-safe fspec)) ;; Macroexpanded lambda?
+    (when (memq (car-safe fspec) '(function quote)) ;; Macroexpanded lambda?
       (setq fspec (eval fspec t)))
     (if (functionp fspec)
         `(funcall ',fspec ',(cadr ifm))
diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el
index f5a150ac4a..40f1f54eed 100644
--- a/lisp/emacs-lisp/oclosure.el
+++ b/lisp/emacs-lisp/oclosure.el
@@ -568,7 +568,7 @@ This has 2 uses:
 (defun cconv--interactive-helper (fun if)
   "Add interactive \"form\" IF to FUN.
 Returns a new command that otherwise behaves like FUN.
-IF should actually not be a form but a function of no arguments."
+IF can be an ELisp form to be interpreted or a function of no arguments."
   (oclosure-lambda (cconv--interactive-helper (fun fun) (if if))
       (&rest args)
     (apply (if (called-interactively-p 'any)
diff --git a/lisp/simple.el b/lisp/simple.el
index 22aa043069..bed6dfb829 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2738,7 +2738,8 @@ instead."
   nil)
 
 (cl-defmethod oclosure-interactive-form ((f cconv--interactive-helper))
-  `(interactive (funcall ',(cconv--interactive-helper--if f))))
+  (let ((if (cconv--interactive-helper--if f)))
+    `(interactive ,(if (functionp if) `(funcall ',if) if))))
 
 (defun command-execute (cmd &optional record-flag keys special)
   ;; BEWARE: Called directly from the C code.
diff --git a/test/lisp/emacs-lisp/nadvice-tests.el 
b/test/lisp/emacs-lisp/nadvice-tests.el
index 748d42f212..987483f00b 100644
--- a/test/lisp/emacs-lisp/nadvice-tests.el
+++ b/test/lisp/emacs-lisp/nadvice-tests.el
@@ -213,8 +213,16 @@ function being an around advice."
     (should (equal (cl-prin1-to-string (car x))
                    "#f(advice first :before #f(advice car :after cdr))"))))
 
-;; Local Variables:
-;; no-byte-compile: t
-;; End:
+(ert-deftest advice-test-bug61179 ()
+  (let* ((magic 42)
+         (ad (lambda (&rest _)
+               (interactive (lambda (is)
+                              (cons magic (advice-eval-interactive-spec is))))
+               nil))
+         (sym (make-symbol "adtest")))
+    (defalias sym (lambda (&rest args) (interactive (list 'main)) args))
+    (should (equal (call-interactively sym) '(main)))
+    (advice-add sym :before ad)
+    (should (equal (call-interactively sym) '(42 main)))))
 
 ;;; nadvice-tests.el ends here