Commit | Line | Data |
---|---|---|
231d8498 SM |
1 | ;;; advice-tests.el --- Test suite for the new advice thingy. |
2 | ||
3 | ;; Copyright (C) 2012 Free Software Foundation, Inc. | |
4 | ||
5 | ;; This file is part of GNU Emacs. | |
6 | ||
7 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
8 | ;; it under the terms of the GNU General Public License as published by | |
9 | ;; the Free Software Foundation, either version 3 of the License, or | |
10 | ;; (at your option) any later version. | |
11 | ||
12 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | ;; GNU General Public License for more details. | |
16 | ||
17 | ;; You should have received a copy of the GNU General Public License | |
18 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
19 | ||
20 | ;;; Commentary: | |
21 | ||
22 | ;;; Code: | |
23 | ||
23ba2705 SM |
24 | (ert-deftest advice-tests () |
25 | "Test advice code." | |
26 | (with-temp-buffer | |
27 | (defun sm-test1 (x) (+ x 4)) | |
28 | (should (equal (sm-test1 6) 10)) | |
29 | (advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5))) | |
30 | (should (equal (sm-test1 6) 50)) | |
31 | (defun sm-test1 (x) (+ x 14)) | |
32 | (should (equal (sm-test1 6) 100)) | |
33 | (should (equal (null (get 'sm-test1 'defalias-fset-function)) nil)) | |
34 | (advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 5))) | |
35 | (should (equal (sm-test1 6) 20)) | |
36 | (should (equal (null (get 'sm-test1 'defalias-fset-function)) t)) | |
37 | ||
38 | (defun sm-test2 (x) (+ x 4)) | |
39 | (should (equal (sm-test2 6) 10)) | |
40 | (defadvice sm-test2 (around sm-test activate) | |
231d8498 | 41 | ad-do-it (setq ad-return-value (* ad-return-value 5))) |
23ba2705 SM |
42 | (should (equal (sm-test2 6) 50)) |
43 | (ad-deactivate 'sm-test2) | |
44 | (should (equal (sm-test2 6) 10)) | |
45 | (ad-activate 'sm-test2) | |
46 | (should (equal (sm-test2 6) 50)) | |
47 | (defun sm-test2 (x) (+ x 14)) | |
48 | (should (equal (sm-test2 6) 100)) | |
49 | (should (equal (null (get 'sm-test2 'defalias-fset-function)) nil)) | |
50 | (ad-remove-advice 'sm-test2 'around 'sm-test) | |
51 | (should (equal (sm-test2 6) 100)) | |
52 | (ad-activate 'sm-test2) | |
53 | (should (equal (sm-test2 6) 20)) | |
54 | (should (equal (null (get 'sm-test2 'defalias-fset-function)) t)) | |
55 | ||
56 | (advice-add 'sm-test3 :around | |
413d4689 SM |
57 | (lambda (f &rest args) `(toto ,(apply f args))) |
58 | '((name . wrap-with-toto))) | |
59 | (defmacro sm-test3 (x) `(call-test3 ,x)) | |
23ba2705 | 60 | (should (equal (macroexpand '(sm-test3 56)) '(toto (call-test3 56)))) |
413d4689 | 61 | |
23ba2705 | 62 | (defadvice sm-test4 (around wrap-with-toto activate) |
3c442f8b SM |
63 | ad-do-it (setq ad-return-value `(toto ,ad-return-value))) |
64 | (defmacro sm-test4 (x) `(call-test4 ,x)) | |
23ba2705 SM |
65 | (should (equal (macroexpand '(sm-test4 56)) '(toto (call-test4 56)))) |
66 | (defmacro sm-test4 (x) `(call-testq ,x)) | |
67 | (should (equal (macroexpand '(sm-test4 56)) '(toto (call-testq 56)))) | |
3c442f8b SM |
68 | |
69 | ;; Combining old style and new style advices. | |
23ba2705 SM |
70 | (defun sm-test5 (x) (+ x 4)) |
71 | (should (equal (sm-test5 6) 10)) | |
72 | (advice-add 'sm-test5 :around (lambda (f y) (* (funcall f y) 5))) | |
73 | (should (equal (sm-test5 6) 50)) | |
74 | (defadvice sm-test5 (around test activate) | |
3c442f8b | 75 | ad-do-it (setq ad-return-value (+ ad-return-value 0.1))) |
23ba2705 SM |
76 | (should (equal (sm-test5 5) 45.1)) |
77 | (ad-deactivate 'sm-test5) | |
78 | (should (equal (sm-test5 6) 50)) | |
79 | (ad-activate 'sm-test5) | |
80 | (should (equal (sm-test5 6) 50.1)) | |
81 | (defun sm-test5 (x) (+ x 14)) | |
82 | (should (equal (sm-test5 6) 100.1)) | |
83 | (advice-remove 'sm-test5 (lambda (f y) (* (funcall f y) 5))) | |
84 | (should (equal (sm-test5 6) 20.1)) | |
dd0c5bbb SM |
85 | |
86 | ;; This used to signal an error (bug#12858). | |
23ba2705 | 87 | (autoload 'sm-test6 "foo") |
dd0c5bbb SM |
88 | (defadvice sm-test6 (around test activate) |
89 | ad-do-it) | |
dd0c5bbb | 90 | |
23ba2705 SM |
91 | ;; Check interaction between advice and called-interactively-p. |
92 | (defun sm-test7 (&optional x) (interactive) (+ (or x 7) 4)) | |
93 | (advice-add 'sm-test7 :around | |
94 | (lambda (f &rest args) | |
95 | (list (cons 1 (called-interactively-p)) (apply f args)))) | |
96 | (should (equal (sm-test7) '((1 . nil) 11))) | |
97 | (should (equal (call-interactively 'sm-test7) '((1 . t) 11))) | |
98 | (let ((smi 7)) | |
99 | (advice-add 'sm-test7 :before | |
100 | (lambda (&rest args) | |
101 | (setq smi (called-interactively-p)))) | |
102 | (should (equal (list (sm-test7) smi) | |
103 | '(((1 . nil) 11) nil))) | |
104 | (should (equal (list (call-interactively 'sm-test7) smi) | |
105 | '(((1 . t) 11) t)))) | |
106 | (advice-add 'sm-test7 :around | |
107 | (lambda (f &rest args) | |
108 | (cons (cons 2 (called-interactively-p)) (apply f args)))) | |
109 | (should (equal (call-interactively 'sm-test7) '((2 . t) (1 . t) 11))) | |
231d8498 SM |
110 | )) |
111 | ||
231d8498 SM |
112 | ;; Local Variables: |
113 | ;; no-byte-compile: t | |
114 | ;; End: | |
115 | ||
116 | ;;; advice-tests.el ends here. |