[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r111529: * lisp/emacs-lisp/advice.el
From: |
Stefan Monnier |
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r111529: * lisp/emacs-lisp/advice.el (ad-preactivate-advice): Adjust the cleanup to |
Date: |
Tue, 15 Jan 2013 01:05:22 -0500 |
User-agent: |
Bazaar (2.5.0) |
------------------------------------------------------------
revno: 111529
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Tue 2013-01-15 01:05:22 -0500
message:
* lisp/emacs-lisp/advice.el (ad-preactivate-advice): Adjust the cleanup to
the use of nadvice.el.
* lisp/emacs-lisp/nadvice.el (advice--tweak): Make it possible for `tweak'
to return an explicit nil.
(advice--remove-function): Change accordingly.
* test/automated/advice-tests.el: Split up. Add advice-test-preactivate.
modified:
lisp/ChangeLog
lisp/emacs-lisp/advice.el
lisp/emacs-lisp/nadvice.el
test/ChangeLog
test/automated/advice-tests.el
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2013-01-15 04:20:13 +0000
+++ b/lisp/ChangeLog 2013-01-15 06:05:22 +0000
@@ -1,5 +1,12 @@
2013-01-15 Stefan Monnier <address@hidden>
+ * emacs-lisp/nadvice.el (advice--tweak): Make it possible for `tweak'
+ to return an explicit nil.
+ (advice--remove-function): Change accordingly.
+
+ * emacs-lisp/advice.el (ad-preactivate-advice): Adjust the cleanup to
+ the use of nadvice.el.
+
* progmodes/which-func.el (which-function): Silence imenu errors
(bug#13433).
=== modified file 'lisp/emacs-lisp/advice.el'
--- a/lisp/emacs-lisp/advice.el 2013-01-08 15:24:56 +0000
+++ b/lisp/emacs-lisp/advice.el 2013-01-15 06:05:22 +0000
@@ -2866,10 +2866,8 @@
(defun ad-preactivate-advice (function advice class position)
"Preactivate FUNCTION and returns the constructed cache."
- (let* ((function-defined-p (fboundp function))
- (old-definition
- (if function-defined-p
- (symbol-function function)))
+ (let* ((advicefunname (ad-get-advice-info-field function 'advicefunname))
+ (old-advice (symbol-function advicefunname))
(old-advice-info (ad-copy-advice-info function))
(ad-advised-functions ad-advised-functions))
(unwind-protect
@@ -2883,10 +2881,9 @@
(list (ad-get-cache-definition function)
(ad-get-cache-id function))))
(ad-set-advice-info function old-advice-info)
- ;; Don't `fset' function to nil if it was previously unbound:
- (if function-defined-p
- (fset function old-definition)
- (fmakunbound function)))))
+ (advice-remove function advicefunname)
+ (fset advicefunname old-advice)
+ (if old-advice (advice-add function :around advicefunname)))))
;; @@ Activation and definition handling:
=== modified file 'lisp/emacs-lisp/nadvice.el'
--- a/lisp/emacs-lisp/nadvice.el 2013-01-08 15:24:56 +0000
+++ b/lisp/emacs-lisp/nadvice.el 2013-01-15 06:05:22 +0000
@@ -173,20 +173,21 @@
(let ((first (advice--car flist))
(rest (advice--cdr flist))
(props (advice--props flist)))
- (or (funcall tweaker first rest props)
+ (let ((val (funcall tweaker first rest props)))
+ (if val (car val)
(let ((nrest (advice--tweak rest tweaker)))
(if (eq rest nrest) flist
(advice--make-1 (aref flist 1) (aref flist 3)
- first nrest props)))))))
+ first nrest props))))))))
;;;###autoload
(defun advice--remove-function (flist function)
(advice--tweak flist
(lambda (first rest props)
- (if (or (not first)
- (equal function first)
+ (cond ((not first) rest)
+ ((or (equal function first)
(equal function (cdr (assq 'name props))))
- rest))))
+ (list rest))))))
(defvar advice--buffer-local-function-sample nil)
=== modified file 'test/ChangeLog'
--- a/test/ChangeLog 2013-01-14 01:08:13 +0000
+++ b/test/ChangeLog 2013-01-15 06:05:22 +0000
@@ -1,3 +1,7 @@
+2013-01-15 Stefan Monnier <address@hidden>
+
+ * automated/advice-tests.el: Split up. Add advice-test-preactivate.
+
2013-01-14 Glenn Morris <address@hidden>
* automated/compile-tests.el (compile-tests--test-regexps-data):
=== modified file 'test/automated/advice-tests.el'
--- a/test/automated/advice-tests.el 2013-01-07 18:03:01 +0000
+++ b/test/automated/advice-tests.el 2013-01-15 06:05:22 +0000
@@ -21,99 +21,112 @@
;;; Code:
-(ert-deftest advice-tests ()
+(ert-deftest advice-tests-nadvice ()
+ "Test nadvice code."
+ (defun sm-test1 (x) (+ x 4))
+ (should (equal (sm-test1 6) 10))
+ (advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5)))
+ (should (equal (sm-test1 6) 50))
+ (defun sm-test1 (x) (+ x 14))
+ (should (equal (sm-test1 6) 100))
+ (should (equal (null (get 'sm-test1 'defalias-fset-function)) nil))
+ (advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 5)))
+ (should (equal (sm-test1 6) 20))
+ (should (equal (get 'sm-test1 'defalias-fset-function) nil))
+
+ (advice-add 'sm-test3 :around
+ (lambda (f &rest args) `(toto ,(apply f args)))
+ '((name . wrap-with-toto)))
+ (defmacro sm-test3 (x) `(call-test3 ,x))
+ (should (equal (macroexpand '(sm-test3 56)) '(toto (call-test3 56)))))
+
+(ert-deftest advice-tests-advice ()
"Test advice code."
- (with-temp-buffer
- (defun sm-test1 (x) (+ x 4))
- (should (equal (sm-test1 6) 10))
- (advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5)))
- (should (equal (sm-test1 6) 50))
- (defun sm-test1 (x) (+ x 14))
- (should (equal (sm-test1 6) 100))
- (should (equal (null (get 'sm-test1 'defalias-fset-function)) nil))
- (advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 5)))
- (should (equal (sm-test1 6) 20))
- (should (equal (null (get 'sm-test1 'defalias-fset-function)) t))
-
- (defun sm-test2 (x) (+ x 4))
- (should (equal (sm-test2 6) 10))
- (defadvice sm-test2 (around sm-test activate)
- ad-do-it (setq ad-return-value (* ad-return-value 5)))
- (should (equal (sm-test2 6) 50))
- (ad-deactivate 'sm-test2)
- (should (equal (sm-test2 6) 10))
- (ad-activate 'sm-test2)
- (should (equal (sm-test2 6) 50))
- (defun sm-test2 (x) (+ x 14))
- (should (equal (sm-test2 6) 100))
- (should (equal (null (get 'sm-test2 'defalias-fset-function)) nil))
- (ad-remove-advice 'sm-test2 'around 'sm-test)
- (should (equal (sm-test2 6) 100))
- (ad-activate 'sm-test2)
- (should (equal (sm-test2 6) 20))
- (should (equal (null (get 'sm-test2 'defalias-fset-function)) t))
-
- (advice-add 'sm-test3 :around
- (lambda (f &rest args) `(toto ,(apply f args)))
- '((name . wrap-with-toto)))
- (defmacro sm-test3 (x) `(call-test3 ,x))
- (should (equal (macroexpand '(sm-test3 56)) '(toto (call-test3 56))))
-
- (defadvice sm-test4 (around wrap-with-toto activate)
- ad-do-it (setq ad-return-value `(toto ,ad-return-value)))
- (defmacro sm-test4 (x) `(call-test4 ,x))
- (should (equal (macroexpand '(sm-test4 56)) '(toto (call-test4 56))))
- (defmacro sm-test4 (x) `(call-testq ,x))
- (should (equal (macroexpand '(sm-test4 56)) '(toto (call-testq 56))))
-
- ;; Combining old style and new style advices.
- (defun sm-test5 (x) (+ x 4))
- (should (equal (sm-test5 6) 10))
- (advice-add 'sm-test5 :around (lambda (f y) (* (funcall f y) 5)))
- (should (equal (sm-test5 6) 50))
- (defadvice sm-test5 (around test activate)
- ad-do-it (setq ad-return-value (+ ad-return-value 0.1)))
- (should (equal (sm-test5 5) 45.1))
- (ad-deactivate 'sm-test5)
- (should (equal (sm-test5 6) 50))
- (ad-activate 'sm-test5)
- (should (equal (sm-test5 6) 50.1))
- (defun sm-test5 (x) (+ x 14))
- (should (equal (sm-test5 6) 100.1))
- (advice-remove 'sm-test5 (lambda (f y) (* (funcall f y) 5)))
- (should (equal (sm-test5 6) 20.1))
-
- ;; This used to signal an error (bug#12858).
- (autoload 'sm-test6 "foo")
- (defadvice sm-test6 (around test activate)
- ad-do-it)
-
- ;; Check interaction between advice and called-interactively-p.
- (defun sm-test7 (&optional x) (interactive) (+ (or x 7) 4))
- (advice-add 'sm-test7 :around
- (lambda (f &rest args)
- (list (cons 1 (called-interactively-p)) (apply f args))))
- (should (equal (sm-test7) '((1 . nil) 11)))
- (should (equal (call-interactively 'sm-test7) '((1 . t) 11)))
- (let ((smi 7))
- (advice-add 'sm-test7 :before
- (lambda (&rest args)
- (setq smi (called-interactively-p))))
- (should (equal (list (sm-test7) smi)
- '(((1 . nil) 11) nil)))
- (should (equal (list (call-interactively 'sm-test7) smi)
- '(((1 . t) 11) t))))
- (advice-add 'sm-test7 :around
- (lambda (f &rest args)
- (cons (cons 2 (called-interactively-p)) (apply f args))))
- (should (equal (call-interactively 'sm-test7) '((2 . t) (1 . t) 11)))
-
- ;; Check handling of interactive spec.
- (defun sm-test8 (a) (interactive "p") a)
- (defadvice sm-test8 (before adv1 activate) nil)
- (defadvice sm-test8 (before adv2 activate) (interactive "P") nil)
- (should (equal (interactive-form 'sm-test8) '(interactive "P")))
- ))
+ (defun sm-test2 (x) (+ x 4))
+ (should (equal (sm-test2 6) 10))
+ (defadvice sm-test2 (around sm-test activate)
+ ad-do-it (setq ad-return-value (* ad-return-value 5)))
+ (should (equal (sm-test2 6) 50))
+ (ad-deactivate 'sm-test2)
+ (should (equal (sm-test2 6) 10))
+ (ad-activate 'sm-test2)
+ (should (equal (sm-test2 6) 50))
+ (defun sm-test2 (x) (+ x 14))
+ (should (equal (sm-test2 6) 100))
+ (should (equal (null (get 'sm-test2 'defalias-fset-function)) nil))
+ (ad-remove-advice 'sm-test2 'around 'sm-test)
+ (should (equal (sm-test2 6) 100))
+ (ad-activate 'sm-test2)
+ (should (equal (sm-test2 6) 20))
+ (should (equal (null (get 'sm-test2 'defalias-fset-function)) t))
+
+ (defadvice sm-test4 (around wrap-with-toto activate)
+ ad-do-it (setq ad-return-value `(toto ,ad-return-value)))
+ (defmacro sm-test4 (x) `(call-test4 ,x))
+ (should (equal (macroexpand '(sm-test4 56)) '(toto (call-test4 56))))
+ (defmacro sm-test4 (x) `(call-testq ,x))
+ (should (equal (macroexpand '(sm-test4 56)) '(toto (call-testq 56))))
+
+ ;; This used to signal an error (bug#12858).
+ (autoload 'sm-test6 "foo")
+ (defadvice sm-test6 (around test activate)
+ ad-do-it))
+
+(ert-deftest advice-tests-combination ()
+ "Combining old style and new style advices."
+ (defun sm-test5 (x) (+ x 4))
+ (should (equal (sm-test5 6) 10))
+ (advice-add 'sm-test5 :around (lambda (f y) (* (funcall f y) 5)))
+ (should (equal (sm-test5 6) 50))
+ (defadvice sm-test5 (around test activate)
+ ad-do-it (setq ad-return-value (+ ad-return-value 0.1)))
+ (should (equal (sm-test5 5) 45.1))
+ (ad-deactivate 'sm-test5)
+ (should (equal (sm-test5 6) 50))
+ (ad-activate 'sm-test5)
+ (should (equal (sm-test5 6) 50.1))
+ (defun sm-test5 (x) (+ x 14))
+ (should (equal (sm-test5 6) 100.1))
+ (advice-remove 'sm-test5 (lambda (f y) (* (funcall f y) 5)))
+ (should (equal (sm-test5 6) 20.1)))
+
+(ert-deftest advice-test-called-interactively-p ()
+ "Check interaction between advice and called-interactively-p."
+ (defun sm-test7 (&optional x) (interactive) (+ (or x 7) 4))
+ (advice-add 'sm-test7 :around
+ (lambda (f &rest args)
+ (list (cons 1 (called-interactively-p)) (apply f args))))
+ (should (equal (sm-test7) '((1 . nil) 11)))
+ (should (equal (call-interactively 'sm-test7) '((1 . t) 11)))
+ (let ((smi 7))
+ (advice-add 'sm-test7 :before
+ (lambda (&rest args)
+ (setq smi (called-interactively-p))))
+ (should (equal (list (sm-test7) smi)
+ '(((1 . nil) 11) nil)))
+ (should (equal (list (call-interactively 'sm-test7) smi)
+ '(((1 . t) 11) t))))
+ (advice-add 'sm-test7 :around
+ (lambda (f &rest args)
+ (cons (cons 2 (called-interactively-p)) (apply f args))))
+ (should (equal (call-interactively 'sm-test7) '((2 . t) (1 . t) 11))))
+
+(ert-deftest advice-test-interactive ()
+ "Check handling of interactive spec."
+ (defun sm-test8 (a) (interactive "p") a)
+ (defadvice sm-test8 (before adv1 activate) nil)
+ (defadvice sm-test8 (before adv2 activate) (interactive "P") nil)
+ (should (equal (interactive-form 'sm-test8) '(interactive "P"))))
+
+(ert-deftest advice-test-preactivate ()
+ (should (equal (null (get 'sm-test9 'defalias-fset-function)) t))
+ (defun sm-test9 (a) (interactive "p") a)
+ (should (equal (null (get 'sm-test9 'defalias-fset-function)) t))
+ (defadvice sm-test9 (before adv1 pre act protect compile) nil)
+ (should (equal (null (get 'sm-test9 'defalias-fset-function)) nil))
+ (defadvice sm-test9 (before adv2 pre act protect compile)
+ (interactive "P") nil)
+ (should (equal (interactive-form 'sm-test9) '(interactive "P"))))
;; Local Variables:
;; no-byte-compile: t
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r111529: * lisp/emacs-lisp/advice.el (ad-preactivate-advice): Adjust the cleanup to,
Stefan Monnier <=