aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMattias EngdegÄrd2019-03-12 13:19:35 +0100
committerMattias EngdegÄrd2019-03-28 23:57:34 +0100
commiteb6bbd9fb175cacdfdc54c1187f5785ed3858f2f (patch)
tree9d9d04fadb4bef4c9c71cfc63316f39dd767ee84
parentdd30154e27b1085939abf144daaf257ebda0c3d6 (diff)
downloademacs-eb6bbd9fb175cacdfdc54c1187f5785ed3858f2f.tar.gz
emacs-eb6bbd9fb175cacdfdc54c1187f5785ed3858f2f.zip
Use memql instead of memq in pcase
* lisp/emacs-lisp/pcase.el (pcase--u1): Use memql instead of memq to work with bignums (Bug#34781). * test/lisp/emacs-lisp/pcase-tests.el (pcase-tests-member): Test the above.
-rw-r--r--lisp/emacs-lisp/pcase.el8
-rw-r--r--test/lisp/emacs-lisp/pcase-tests.el4
2 files changed, 7 insertions, 5 deletions
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 9de24015494..a644453a948 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -785,7 +785,7 @@ Otherwise, it defers to REST which is a list of branches of the form
785 ((eq 'or (caar matches)) 785 ((eq 'or (caar matches))
786 (let* ((alts (cdar matches)) 786 (let* ((alts (cdar matches))
787 (var (if (eq (caar alts) 'match) (cadr (car alts)))) 787 (var (if (eq (caar alts) 'match) (cadr (car alts))))
788 (simples '()) (others '()) (memq-ok t)) 788 (simples '()) (others '()) (memql-ok t))
789 (when var 789 (when var
790 (dolist (alt alts) 790 (dolist (alt alts)
791 (if (and (eq (car alt) 'match) (eq var (cadr alt)) 791 (if (and (eq (car alt) 'match) (eq var (cadr alt))
@@ -793,16 +793,16 @@ Otherwise, it defers to REST which is a list of branches of the form
793 (eq (car-safe upat) 'quote))) 793 (eq (car-safe upat) 'quote)))
794 (let ((val (cadr (cddr alt)))) 794 (let ((val (cadr (cddr alt))))
795 (unless (or (integerp val) (symbolp val)) 795 (unless (or (integerp val) (symbolp val))
796 (setq memq-ok nil)) 796 (setq memql-ok nil))
797 (push (cadr (cddr alt)) simples)) 797 (push (cadr (cddr alt)) simples))
798 (push alt others)))) 798 (push alt others))))
799 (cond 799 (cond
800 ((null alts) (error "Please avoid it") (pcase--u rest)) 800 ((null alts) (error "Please avoid it") (pcase--u rest))
801 ;; Yes, we can use `memq' (or `member')! 801 ;; Yes, we can use `memql' (or `member')!
802 ((> (length simples) 1) 802 ((> (length simples) 1)
803 (pcase--u1 (cons `(match ,var 803 (pcase--u1 (cons `(match ,var
804 . (pred (pcase--flip 804 . (pred (pcase--flip
805 ,(if memq-ok #'memq #'member) 805 ,(if memql-ok #'memql #'member)
806 ',simples))) 806 ',simples)))
807 (cdr matches)) 807 (cdr matches))
808 code vars 808 code vars
diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el
index 1e9d37fbfa9..af8c9a3f3c3 100644
--- a/test/lisp/emacs-lisp/pcase-tests.el
+++ b/test/lisp/emacs-lisp/pcase-tests.el
@@ -51,11 +51,13 @@
51 51
52(ert-deftest pcase-tests-member () 52(ert-deftest pcase-tests-member ()
53 (should (pcase-tests-grep 53 (should (pcase-tests-grep
54 'memq (macroexpand-all '(pcase x ((or 1 2 3) body))))) 54 'memql (macroexpand-all '(pcase x ((or 1 2 3) body)))))
55 (should (pcase-tests-grep 55 (should (pcase-tests-grep
56 'member (macroexpand-all '(pcase x ((or "a" 2 3) body))))) 56 'member (macroexpand-all '(pcase x ((or "a" 2 3) body)))))
57 (should-not (pcase-tests-grep 57 (should-not (pcase-tests-grep
58 'memq (macroexpand-all '(pcase x ((or "a" 2 3) body))))) 58 'memq (macroexpand-all '(pcase x ((or "a" 2 3) body)))))
59 (should-not (pcase-tests-grep
60 'memql (macroexpand-all '(pcase x ((or "a" 2 3) body)))))
59 (let ((exp (macroexpand-all 61 (let ((exp (macroexpand-all
60 '(pcase x 62 '(pcase x
61 ("a" body1) 63 ("a" body1)