code.delx.au - gnu-emacs/blob - test/automated/advice-tests.el

   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
  24 (defvar advice-tests--data
  25   '(((defun sm-test1 (x) (+ x 4))
  26      (sm-test1 6) 10)
  27     ((advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5)))
  28      (sm-test1 6) 50)
  29     ((defun sm-test1 (x) (+ x 14))
  30      (sm-test1 6) 100)
  31     ((null (get 'sm-test1 'defalias-fset-function)) nil)
  32     ((advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 5)))
  33      (sm-test1 6) 20)
  34     ((null (get 'sm-test1 'defalias-fset-function)) t)
  35
  36     ((defun sm-test2 (x) (+ x 4))
  37      (sm-test2 6) 10)
  38     ((defadvice sm-test2 (around sm-test activate)
  39        ad-do-it (setq ad-return-value (* ad-return-value 5)))
  40      (sm-test2 6) 50)
  41     ((ad-deactivate 'sm-test2)
  42      (sm-test2 6) 10)
  43     ((ad-activate 'sm-test2)
  44      (sm-test2 6) 50)
  45     ((defun sm-test2 (x) (+ x 14))
  46      (sm-test2 6) 100)
  47     ((null (get 'sm-test2 'defalias-fset-function)) nil)
  48     ((ad-remove-advice 'sm-test2 'around 'sm-test)
  49      (sm-test2 6) 100)
  50     ((ad-activate 'sm-test2)
  51      (sm-test2 6) 20)
  52     ((null (get 'sm-test2 'defalias-fset-function)) t)
  53
  54     ((advice-add 'sm-test3 :around
  55                  (lambda (f &rest args) `(toto ,(apply f args)))
  56                  '((name . wrap-with-toto)))
  57      (defmacro sm-test3 (x) `(call-test3 ,x))
  58      (macroexpand '(sm-test3 56)) (toto (call-test3 56)))
  59
  60     ))
  61
  62 (ert-deftest advice-tests ()
  63   "Test advice code."
  64   (with-temp-buffer
  65     (dolist (test advice-tests--data)
  66       (let ((res (eval `(progn ,@(butlast test)))))
  67         (should (equal (car (last test)) res))))))
  68
  69 ;; Local Variables:
  70 ;; no-byte-compile: t
  71 ;; End:
  72
  73 ;;; advice-tests.el ends here.