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
  55 (ert-deftest advice-tests ()
  56   "Test advice code."
  57   (with-temp-buffer
  58     (dolist (test advice-tests--data)
  59       (let ((res (eval `(progn ,@(butlast test)))))
  60         (should (equal (car (last test)) res))))))
  61
  62 ;; Local Variables:
  63 ;; no-byte-compile: t
  64 ;; End:
  65
  66 ;;; advice-tests.el ends here.