Commit 31dca772 authored by Ryan's avatar Ryan Committed by Stefan Monnier
Browse files

* lisp/subr.el (internal--call-interactively): New const.

(called-interactively-p): Use it.
* test/automated/advice-tests.el (advice-test-called-interactively-p-around)
(advice-test-called-interactively-p-filter-args)
(advice-test-called-interactively-p-around): New tests.

Fixes: debbugs:3984
parent 1e835c22
2013-09-20 Stefan Monnier <monnier@iro.umontreal.ca>
* subr.el (internal--call-interactively): New const.
(called-interactively-p): Use it (bug#3984).
2013-09-20 Xue Fuqiao <xfq.free@gmail.com>
* vc/pcvs.el (cvs-mode-ignore):
......
......@@ -4246,6 +4246,8 @@ I is the index of the frame after FRAME2. It should return nil
if those frames don't seem special and otherwise, it should return
the number of frames to skip (minus 1).")
(defconst internal--call-interactively (symbol-function 'call-interactively))
(defun called-interactively-p (&optional kind)
"Return t if the containing function was called by `call-interactively'.
If KIND is `interactive', then only return t if the call was made
......@@ -4318,9 +4320,9 @@ command is called from a keyboard macro?"
(pcase (cons frame nextframe)
;; No subr calls `interactive-p', so we can rule that out.
(`((,_ ,(pred (lambda (f) (subrp (indirect-function f)))) . ,_) . ,_) nil)
;; Somehow, I sometimes got `command-execute' rather than
;; `call-interactively' on my stacktrace !?
;;(`(,_ . (t command-execute . ,_)) t)
;; In case #<subr call-interactively> without going through the
;; `call-interactively' symbol (bug#3984).
(`(,_ . (t ,(pred (eq internal--call-interactively)) . ,_)) t)
(`(,_ . (t call-interactively . ,_)) t)))))
(defun interactive-p ()
......
2013-09-20 Ryan <rct@thompsonclan.org> (tiny change)
* automated/advice-tests.el (advice-test-called-interactively-p-around)
(advice-test-called-interactively-p-filter-args)
(advice-test-called-interactively-p-around): New tests.
2013-09-16 Glenn Morris <rgm@gnu.org>
* automated/eshell.el (eshell-match-result):
......
......@@ -130,6 +130,38 @@
(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-around ()
"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)))
(advice-add 'sm-test7.2 :around
(lambda (f &rest args)
(list (cons 1 (called-interactively-p)) (apply f args))))
(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-filter-args ()
"Check interaction between filter-args advice and called-interactively-p."
:expected-result :failed
(defun sm-test7.3 () (interactive) (cons 1 (called-interactively-p)))
(advice-add 'sm-test7.3 :filter-args #'list)
(should (equal (sm-test7.3) '(1 . nil)))
(should (equal (call-interactively 'sm-test7.3) '(1 . t))))
(ert-deftest advice-test-call-interactively ()
"Check interaction between advice on call-interactively and called-interactively-p."
(defun sm-test7.4 () (interactive) (cons 1 (called-interactively-p)))
(let ((old (symbol-function 'call-interactively)))
(unwind-protect
(progn
(advice-add 'call-interactively :before #'ignore)
(should (equal (sm-test7.4) '(1 . nil)))
(should (equal (call-interactively 'sm-test7.4) '(1 . t))))
(fset 'call-interactively old))))
(ert-deftest advice-test-interactive ()
"Check handling of interactive spec."
(defun sm-test8 (a) (interactive "p") a)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment