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

   1 ;;; pcase-tests.el --- Test suite for pcase macro.
   2
   3 ;; Copyright (C) 2012-2016 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 (require 'ert)
  25 (require 'cl-lib)
  26
  27 (ert-deftest pcase-tests-base ()
  28   "Test pcase code."
  29   (should (equal (pcase '(1 . 2) ((app car '2) 6) ((app car '1) 5)) 5)))
  30
  31 (ert-deftest pcase-tests-bugs ()
  32   (should (equal (pcase '(2 . 3)        ;bug#18554
  33                    (`(,hd . ,(and (pred atom) tl)) (list hd tl))
  34                    ((pred consp) nil))
  35                  '(2 3))))
  36
  37 (pcase-defmacro pcase-tests-plus (pat n)
  38   `(app (lambda (v) (- v ,n)) ,pat))
  39
  40 (ert-deftest pcase-tests-macro ()
  41   (should (equal (pcase 5 ((pcase-tests-plus x 3) x)) 2)))
  42
  43 (defun pcase-tests-grep (fname exp)
  44   (when (consp exp)
  45     (or (eq fname (car exp))
  46         (cl-some (lambda (exp) (pcase-tests-grep fname exp)) (cdr exp)))))
  47
  48 (ert-deftest pcase-tests-tests ()
  49   (should (pcase-tests-grep 'memq '(or (+ 2 3) (memq x y))))
  50   (should-not (pcase-tests-grep 'memq '(or (+ 2 3) (- x y)))))
  51
  52 (ert-deftest pcase-tests-member ()
  53   (should (pcase-tests-grep
  54            'memq (macroexpand-all '(pcase x ((or 1 2 3) body)))))
  55   (should (pcase-tests-grep
  56            'member (macroexpand-all '(pcase x ((or '"a" '2 '3) body)))))
  57   (should-not (pcase-tests-grep
  58                'memq (macroexpand-all '(pcase x ((or "a" 2 3) body)))))
  59   (let ((exp (macroexpand-all
  60                       '(pcase x
  61                          ("a" body1)
  62                          (2 body2)
  63                          ((or "a" 2 3) body)))))
  64     (should-not (pcase-tests-grep 'memq exp))
  65     (should-not (pcase-tests-grep 'member exp))))
  66
  67 (ert-deftest pcase-tests-vectors ()
  68   (should (equal (pcase [1 2] (`[,x] 1) (`[,x ,y] (+ x y))) 3)))
  69
  70 ;; Local Variables:
  71 ;; no-byte-compile: t
  72 ;; End:
  73
  74 ;;; pcase-tests.el ends here.