bug#3984:

[Ryan <rct@thompsonclan.org>]

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

On Thu Sep 19 12:23:58 2013, Ryan wrote:
>
> On a related note, I just noticed that the
> "advice-test-called-interactively-p" test in
> test/automated/advice-tests.el happens to pass, but only because it
> doesn't use "called-interactively-p" inside the original function, but
> rather only inside the advice itself. Also, it doesn't test advising
> "call-interactively" itself. I think I will see about writing a proper
> test first, and then use that to start debugging.
>
Ok, I have written a couple of tests, two of which are currently failing 
(mine are the ones with numbered suffixes 2 through 5). I am attaching a 
patch that adds these tests. ERT output is below:

$ open .
techne:emacs-trunk ryan$ src/emacs -batch -Q -l ert -l 
test/automated/advice-tests.el -f ert-run-tests-batch-and-exit
Running 10 tests (2013-09-19 14:56:00-0700)
    passed   1/10  advice-test-called-interactively-p
    failed   2/10  advice-test-called-interactively-p-2
    passed   3/10  advice-test-called-interactively-p-3
    failed   4/10  advice-test-called-interactively-p-4
    passed   5/10  advice-test-called-interactively-p-5
    passed   6/10  advice-test-interactive
    passed   7/10  advice-test-preactivate
ad-handle-definition: `sm-test2' got redefined
ad-handle-definition: `sm-test4' got redefined
    passed   8/10  advice-tests-advice
ad-handle-definition: `sm-test5' got redefined
    passed   9/10  advice-tests-combination
    passed  10/10  advice-tests-nadvice

Ran 10 tests, 10 results as expected (2013-09-19 14:56:00-0700)
2 expected failures

[-- Attachment #2: more-advice-interactive-tests.diff --]
[-- Type: text/plain, Size: 3609 bytes --]

diff --git a/test/automated/advice-tests.el b/test/automated/advice-tests.el
index 69c15e3..65577ad 100644
--- a/test/automated/advice-tests.el
+++ b/test/automated/advice-tests.el
@@ -23,6 +23,21 @@
 
 (require 'ert)
 
+(defun clear-advice (symbol)
+  "Reset SYMBOL's function to its original unadvised definition."
+  (let ((func (symbol-function symbol)))
+    (while (advice--p func)
+      (setq func (advice--cdr func)))
+    (fset symbol func)))
+
+(defmacro post-restore-func (func &rest body)
+  (let ((fdef (symbol-function func)))
+    `(unwind-protect
+	 (progn ,@body)
+       (fset ',func ,fdef))))
+(put 'post-restore-func 'lisp-indent-function
+     (get 'prog1 'lisp-indent-function))
+
 (ert-deftest advice-tests-nadvice ()
   "Test nadvice code."
   (defun sm-test1 (x) (+ x 4))
@@ -113,6 +128,60 @@
                 (cons (cons 2 (called-interactively-p)) (apply f args))))
   (should (equal (call-interactively 'sm-test7) '((2 . t) (1 . t) 11))))
 
+(ert-deftest advice-test-called-interactively-p-2 ()
+  "Check interaction between around advice and called-interactively-p.
+
+This tests the currently broken case of the innermost advice to a
+function being an around advice."
+  :expected-result :failed
+  (defun sm-test7.2 () (interactive) (cons 1 (called-interactively-p)))
+  (clear-advice 'sm-test7.2)
+  (advice-add 'sm-test7.2 :around
+              (lambda (f &rest args)
+                (list (cons 1 (called-interactively-p)) (apply f args))))
+  (advice-add 'sm-test7.2 :before #'ignore)
+  (advice-add 'sm-test7.2 :after #'ignore)
+  ;(advice-add 'sm-test7.2 :filter-args #'list)
+  ;(advice-add 'sm-test7.2 :filter-return #'identity)
+  (should (equal (sm-test7.2) '((1 . nil) (1 . nil))))
+  (should (equal (call-interactively 'sm-test7.2) '((1 . t) (1 . t)))))
+
+(ert-deftest advice-test-called-interactively-p-3 ()
+  "Check interaction between before advice and called-interactively-p.
+
+This tests the case of the innermost advice being before"
+  (defun sm-test7.3 () (interactive) (cons 1 (called-interactively-p)))
+  (advice-add 'sm-test7.3 :before #'ignore)
+  ;(advice-add 'sm-test7.3 :filter-args #'list)
+  ;(advice-add 'sm-test7.3 :filter-return #'identity)
+  (should (equal (sm-test7.3) '(1 . nil)))
+  (should (equal (call-interactively 'sm-test7.3) '(1 . t))))
+
+(ert-deftest advice-test-called-interactively-p-4 ()
+  "Check interaction between advice on call-interactively and called-interactively-p.
+
+This tests the case where call-interactively itself is advised,
+which is currently broken."
+  :expected-result :failed
+  (defun sm-test7.4 () (interactive) (cons 1 (called-interactively-p)))
+  (post-restore-func call-interactively
+    (advice-add 'call-interactively :before #'ignore)
+    (should (equal (sm-test7.4) '(1 . nil)))
+    (should (equal (call-interactively 'sm-test7.4) '(1 . t)))))
+
+(ert-deftest advice-test-called-interactively-p-5 ()
+  "Check interaction between non-innermost around advice and called-interactively-p.
+
+This tests the case where a function has around advice, but it is
+not the innermost advice."
+  (defun sm-test7.5 () (interactive) (cons 1 (called-interactively-p)))
+  (advice-add 'sm-test7.5 :before #'ignore)
+  (advice-add 'sm-test7.5 :around #'funcall)
+  ;(advice-add 'sm-test7.5 :filter-args #'list)
+  ;(advice-add 'sm-test7.5 :filter-return #'identity)
+  (should (equal (sm-test7.5) '(1 . nil)))
+  (should (equal (call-interactively 'sm-test7.5) '(1 . t))))
+
 (ert-deftest advice-test-interactive ()
   "Check handling of interactive spec."
   (defun sm-test8 (a) (interactive "p") a)