0d827c7f52
Revert commit a218c98615, but in order
to avoid the spurious warnings that this commit tried to squash,
keep track of the vars used during the match so as to add
corresponding annotations to explicitly silence the spurious warnings.
To do this, we change the VARS used in `pcase-u` (and throughout
the pcase code): they used to hold elements of the form (NAME . VAL)
and now they hold elements of the form (NAME VAL . USED).
(pcase--expand): Bind all vars instead of only those found via fgrep.
(pcase-codegen): Silence "unused var" warnings for those vars that have
already been referenced during the match itself.
(pcase--funcall, pcase--eval): Record the vars that are used.
(pcase--u1): Record the vars that are used via non-linear patterns.
* lisp/textmodes/mhtml-mode.el (mhtml-forward):
* lisp/vc/diff-mode.el (diff-goto-source): Silence newly
discovered warnings.
* test/lisp/emacs-lisp/pcase-tests.el (pcase-tests-bug46786): New test.
97 lines
3.4 KiB
EmacsLisp
97 lines
3.4 KiB
EmacsLisp
;;; 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)))
|
|
|
|
(ert-deftest pcase-tests-bug14773 ()
|
|
(let ((f (lambda (x)
|
|
(pcase 'dummy
|
|
((and (let var x) (guard var)) 'left)
|
|
((and (let var (not x)) (guard var)) 'right)))))
|
|
(should (equal (funcall f t) 'left))
|
|
(should (equal (funcall f nil) 'right))))
|
|
|
|
(ert-deftest pcase-tests-bug46786 ()
|
|
(let ((self 'outer))
|
|
(should (equal (cl-macrolet ((show-self () `(list 'self self)))
|
|
(pcase-let ((`(,self ,self2) '(inner "2")))
|
|
(show-self)))
|
|
'(self inner)))))
|
|
|
|
;; Local Variables:
|
|
;; no-byte-compile: t
|
|
;; End:
|
|
|
|
;;; pcase-tests.el ends here.
|