aboutsummaryrefslogtreecommitdiffstats
path: root/test
diff options
context:
space:
mode:
authorStefan Monnier2013-01-15 01:05:22 -0500
committerStefan Monnier2013-01-15 01:05:22 -0500
commitcb9c0a53bc4a6d67f10d4674472b2884a71852c8 (patch)
treebf43c694ff8de8bc246c19bdc929a336e3dd969b /test
parentef8214345ba7b46de9837fbe9461e19f18e6d660 (diff)
downloademacs-cb9c0a53bc4a6d67f10d4674472b2884a71852c8.tar.gz
emacs-cb9c0a53bc4a6d67f10d4674472b2884a71852c8.zip
* 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.
Diffstat (limited to 'test')
-rw-r--r--test/ChangeLog4
-rw-r--r--test/automated/advice-tests.el197
2 files changed, 109 insertions, 92 deletions
diff --git a/test/ChangeLog b/test/ChangeLog
index 472a6073884..7857000ba2f 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,7 @@
12013-01-15 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * automated/advice-tests.el: Split up. Add advice-test-preactivate.
4
12013-01-14 Glenn Morris <rgm@gnu.org> 52013-01-14 Glenn Morris <rgm@gnu.org>
2 6
3 * automated/compile-tests.el (compile-tests--test-regexps-data): 7 * automated/compile-tests.el (compile-tests--test-regexps-data):
diff --git a/test/automated/advice-tests.el b/test/automated/advice-tests.el
index 238561bef84..8beaea64cd9 100644
--- a/test/automated/advice-tests.el
+++ b/test/automated/advice-tests.el
@@ -21,99 +21,112 @@
21 21
22;;; Code: 22;;; Code:
23 23
24(ert-deftest advice-tests () 24(ert-deftest advice-tests-nadvice ()
25 "Test nadvice code."
26 (defun sm-test1 (x) (+ x 4))
27 (should (equal (sm-test1 6) 10))
28 (advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5)))
29 (should (equal (sm-test1 6) 50))
30 (defun sm-test1 (x) (+ x 14))
31 (should (equal (sm-test1 6) 100))
32 (should (equal (null (get 'sm-test1 'defalias-fset-function)) nil))
33 (advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 5)))
34 (should (equal (sm-test1 6) 20))
35 (should (equal (get 'sm-test1 'defalias-fset-function) nil))
36
37 (advice-add 'sm-test3 :around
38 (lambda (f &rest args) `(toto ,(apply f args)))
39 '((name . wrap-with-toto)))
40 (defmacro sm-test3 (x) `(call-test3 ,x))
41 (should (equal (macroexpand '(sm-test3 56)) '(toto (call-test3 56)))))
42
43(ert-deftest advice-tests-advice ()
25 "Test advice code." 44 "Test advice code."
26 (with-temp-buffer 45 (defun sm-test2 (x) (+ x 4))
27 (defun sm-test1 (x) (+ x 4)) 46 (should (equal (sm-test2 6) 10))
28 (should (equal (sm-test1 6) 10)) 47 (defadvice sm-test2 (around sm-test activate)
29 (advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5))) 48 ad-do-it (setq ad-return-value (* ad-return-value 5)))
30 (should (equal (sm-test1 6) 50)) 49 (should (equal (sm-test2 6) 50))
31 (defun sm-test1 (x) (+ x 14)) 50 (ad-deactivate 'sm-test2)
32 (should (equal (sm-test1 6) 100)) 51 (should (equal (sm-test2 6) 10))
33 (should (equal (null (get 'sm-test1 'defalias-fset-function)) nil)) 52 (ad-activate 'sm-test2)
34 (advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 5))) 53 (should (equal (sm-test2 6) 50))
35 (should (equal (sm-test1 6) 20)) 54 (defun sm-test2 (x) (+ x 14))
36 (should (equal (null (get 'sm-test1 'defalias-fset-function)) t)) 55 (should (equal (sm-test2 6) 100))
37 56 (should (equal (null (get 'sm-test2 'defalias-fset-function)) nil))
38 (defun sm-test2 (x) (+ x 4)) 57 (ad-remove-advice 'sm-test2 'around 'sm-test)
39 (should (equal (sm-test2 6) 10)) 58 (should (equal (sm-test2 6) 100))
40 (defadvice sm-test2 (around sm-test activate) 59 (ad-activate 'sm-test2)
41 ad-do-it (setq ad-return-value (* ad-return-value 5))) 60 (should (equal (sm-test2 6) 20))
42 (should (equal (sm-test2 6) 50)) 61 (should (equal (null (get 'sm-test2 'defalias-fset-function)) t))
43 (ad-deactivate 'sm-test2) 62
44 (should (equal (sm-test2 6) 10)) 63 (defadvice sm-test4 (around wrap-with-toto activate)
45 (ad-activate 'sm-test2) 64 ad-do-it (setq ad-return-value `(toto ,ad-return-value)))
46 (should (equal (sm-test2 6) 50)) 65 (defmacro sm-test4 (x) `(call-test4 ,x))
47 (defun sm-test2 (x) (+ x 14)) 66 (should (equal (macroexpand '(sm-test4 56)) '(toto (call-test4 56))))
48 (should (equal (sm-test2 6) 100)) 67 (defmacro sm-test4 (x) `(call-testq ,x))
49 (should (equal (null (get 'sm-test2 'defalias-fset-function)) nil)) 68 (should (equal (macroexpand '(sm-test4 56)) '(toto (call-testq 56))))
50 (ad-remove-advice 'sm-test2 'around 'sm-test) 69
51 (should (equal (sm-test2 6) 100)) 70 ;; This used to signal an error (bug#12858).
52 (ad-activate 'sm-test2) 71 (autoload 'sm-test6 "foo")
53 (should (equal (sm-test2 6) 20)) 72 (defadvice sm-test6 (around test activate)
54 (should (equal (null (get 'sm-test2 'defalias-fset-function)) t)) 73 ad-do-it))
55 74
56 (advice-add 'sm-test3 :around 75(ert-deftest advice-tests-combination ()
57 (lambda (f &rest args) `(toto ,(apply f args))) 76 "Combining old style and new style advices."
58 '((name . wrap-with-toto))) 77 (defun sm-test5 (x) (+ x 4))
59 (defmacro sm-test3 (x) `(call-test3 ,x)) 78 (should (equal (sm-test5 6) 10))
60 (should (equal (macroexpand '(sm-test3 56)) '(toto (call-test3 56)))) 79 (advice-add 'sm-test5 :around (lambda (f y) (* (funcall f y) 5)))
61 80 (should (equal (sm-test5 6) 50))
62 (defadvice sm-test4 (around wrap-with-toto activate) 81 (defadvice sm-test5 (around test activate)
63 ad-do-it (setq ad-return-value `(toto ,ad-return-value))) 82 ad-do-it (setq ad-return-value (+ ad-return-value 0.1)))
64 (defmacro sm-test4 (x) `(call-test4 ,x)) 83 (should (equal (sm-test5 5) 45.1))
65 (should (equal (macroexpand '(sm-test4 56)) '(toto (call-test4 56)))) 84 (ad-deactivate 'sm-test5)
66 (defmacro sm-test4 (x) `(call-testq ,x)) 85 (should (equal (sm-test5 6) 50))
67 (should (equal (macroexpand '(sm-test4 56)) '(toto (call-testq 56)))) 86 (ad-activate 'sm-test5)
68 87 (should (equal (sm-test5 6) 50.1))
69 ;; Combining old style and new style advices. 88 (defun sm-test5 (x) (+ x 14))
70 (defun sm-test5 (x) (+ x 4)) 89 (should (equal (sm-test5 6) 100.1))
71 (should (equal (sm-test5 6) 10)) 90 (advice-remove 'sm-test5 (lambda (f y) (* (funcall f y) 5)))
72 (advice-add 'sm-test5 :around (lambda (f y) (* (funcall f y) 5))) 91 (should (equal (sm-test5 6) 20.1)))
73 (should (equal (sm-test5 6) 50)) 92
74 (defadvice sm-test5 (around test activate) 93(ert-deftest advice-test-called-interactively-p ()
75 ad-do-it (setq ad-return-value (+ ad-return-value 0.1))) 94 "Check interaction between advice and called-interactively-p."
76 (should (equal (sm-test5 5) 45.1)) 95 (defun sm-test7 (&optional x) (interactive) (+ (or x 7) 4))
77 (ad-deactivate 'sm-test5) 96 (advice-add 'sm-test7 :around
78 (should (equal (sm-test5 6) 50)) 97 (lambda (f &rest args)
79 (ad-activate 'sm-test5) 98 (list (cons 1 (called-interactively-p)) (apply f args))))
80 (should (equal (sm-test5 6) 50.1)) 99 (should (equal (sm-test7) '((1 . nil) 11)))
81 (defun sm-test5 (x) (+ x 14)) 100 (should (equal (call-interactively 'sm-test7) '((1 . t) 11)))
82 (should (equal (sm-test5 6) 100.1)) 101 (let ((smi 7))
83 (advice-remove 'sm-test5 (lambda (f y) (* (funcall f y) 5))) 102 (advice-add 'sm-test7 :before
84 (should (equal (sm-test5 6) 20.1)) 103 (lambda (&rest args)
85 104 (setq smi (called-interactively-p))))
86 ;; This used to signal an error (bug#12858). 105 (should (equal (list (sm-test7) smi)
87 (autoload 'sm-test6 "foo") 106 '(((1 . nil) 11) nil)))
88 (defadvice sm-test6 (around test activate) 107 (should (equal (list (call-interactively 'sm-test7) smi)
89 ad-do-it) 108 '(((1 . t) 11) t))))
90 109 (advice-add 'sm-test7 :around
91 ;; Check interaction between advice and called-interactively-p. 110 (lambda (f &rest args)
92 (defun sm-test7 (&optional x) (interactive) (+ (or x 7) 4)) 111 (cons (cons 2 (called-interactively-p)) (apply f args))))
93 (advice-add 'sm-test7 :around 112 (should (equal (call-interactively 'sm-test7) '((2 . t) (1 . t) 11))))
94 (lambda (f &rest args) 113
95 (list (cons 1 (called-interactively-p)) (apply f args)))) 114(ert-deftest advice-test-interactive ()
96 (should (equal (sm-test7) '((1 . nil) 11))) 115 "Check handling of interactive spec."
97 (should (equal (call-interactively 'sm-test7) '((1 . t) 11))) 116 (defun sm-test8 (a) (interactive "p") a)
98 (let ((smi 7)) 117 (defadvice sm-test8 (before adv1 activate) nil)
99 (advice-add 'sm-test7 :before 118 (defadvice sm-test8 (before adv2 activate) (interactive "P") nil)
100 (lambda (&rest args) 119 (should (equal (interactive-form 'sm-test8) '(interactive "P"))))
101 (setq smi (called-interactively-p)))) 120
102 (should (equal (list (sm-test7) smi) 121(ert-deftest advice-test-preactivate ()
103 '(((1 . nil) 11) nil))) 122 (should (equal (null (get 'sm-test9 'defalias-fset-function)) t))
104 (should (equal (list (call-interactively 'sm-test7) smi) 123 (defun sm-test9 (a) (interactive "p") a)
105 '(((1 . t) 11) t)))) 124 (should (equal (null (get 'sm-test9 'defalias-fset-function)) t))
106 (advice-add 'sm-test7 :around 125 (defadvice sm-test9 (before adv1 pre act protect compile) nil)
107 (lambda (f &rest args) 126 (should (equal (null (get 'sm-test9 'defalias-fset-function)) nil))
108 (cons (cons 2 (called-interactively-p)) (apply f args)))) 127 (defadvice sm-test9 (before adv2 pre act protect compile)
109 (should (equal (call-interactively 'sm-test7) '((2 . t) (1 . t) 11))) 128 (interactive "P") nil)
110 129 (should (equal (interactive-form 'sm-test9) '(interactive "P"))))
111 ;; Check handling of interactive spec.
112 (defun sm-test8 (a) (interactive "p") a)
113 (defadvice sm-test8 (before adv1 activate) nil)
114 (defadvice sm-test8 (before adv2 activate) (interactive "P") nil)
115 (should (equal (interactive-form 'sm-test8) '(interactive "P")))
116 ))
117 130
118;; Local Variables: 131;; Local Variables:
119;; no-byte-compile: t 132;; no-byte-compile: t