1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
;;; pcase-tests.el --- Test suite for pcase macro. -*- lexical-binding:t -*-
;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'ert)
(require 'cl-lib)
(ert-deftest pcase-tests-base ()
"Test pcase code."
(should (equal (pcase '(1 . 2) ((app car '2) 6) ((app car '1) 5)) 5)))
(ert-deftest pcase-tests-bugs ()
(should (equal (pcase '(2 . 3) ;bug#18554
(`(,hd . ,(and (pred atom) tl)) (list hd tl))
((pred consp) nil))
'(2 3)))
(should (equal (pcase '(2 . 3)
(`(,hd . ,(and (pred (not consp)) tl)) (list hd tl))
((pred consp) nil))
'(2 3))))
(pcase-defmacro pcase-tests-plus (pat n)
`(app (lambda (v) (- v ,n)) ,pat))
(ert-deftest pcase-tests-macro ()
(should (equal (pcase 5 ((pcase-tests-plus x 3) x)) 2)))
(defun pcase-tests-grep (fname exp)
(when (consp exp)
(or (eq fname (car exp))
(cl-some (lambda (exp) (pcase-tests-grep fname exp)) (cdr exp)))))
(ert-deftest pcase-tests-tests ()
(should (pcase-tests-grep 'memq '(or (+ 2 3) (memq x y))))
(should-not (pcase-tests-grep 'memq '(or (+ 2 3) (- x y)))))
(ert-deftest pcase-tests-member ()
(should (pcase-tests-grep
'memq (macroexpand-all '(pcase x ((or 'a 'b 'c) body)))))
(should (pcase-tests-grep
'memql (macroexpand-all '(pcase x ((or 1 2 3 'a) body)))))
(should (pcase-tests-grep
'member (macroexpand-all '(pcase x ((or "a" 2 3 'a) body)))))
(should-not (pcase-tests-grep
'memq (macroexpand-all '(pcase x ((or "a" 2 3) body)))))
(should-not (pcase-tests-grep
'memql (macroexpand-all '(pcase x ((or "a" 2 3) body)))))
(let ((exp (macroexpand-all
'(pcase x
("a" body1)
(2 body2)
((or "a" 2 3) body)))))
(should-not (pcase-tests-grep 'memq exp))
(should-not (pcase-tests-grep 'member exp))))
(ert-deftest pcase-tests-vectors ()
(should (equal (pcase [1 2] (`[,x] 1) (`[,x ,y] (+ x y))) 3)))
;; Local Variables:
;; no-byte-compile: t
;; End:
;;; pcase-tests.el ends here.
|
