mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-16 17:24:23 +00:00
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.
This commit is contained in:
parent
dd30154e27
commit
eb6bbd9fb1
2 changed files with 7 additions and 5 deletions
|
|
@ -785,7 +785,7 @@ Otherwise, it defers to REST which is a list of branches of the form
|
|||
((eq 'or (caar matches))
|
||||
(let* ((alts (cdar matches))
|
||||
(var (if (eq (caar alts) 'match) (cadr (car alts))))
|
||||
(simples '()) (others '()) (memq-ok t))
|
||||
(simples '()) (others '()) (memql-ok t))
|
||||
(when var
|
||||
(dolist (alt alts)
|
||||
(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
|
|||
(eq (car-safe upat) 'quote)))
|
||||
(let ((val (cadr (cddr alt))))
|
||||
(unless (or (integerp val) (symbolp val))
|
||||
(setq memq-ok nil))
|
||||
(setq memql-ok nil))
|
||||
(push (cadr (cddr alt)) simples))
|
||||
(push alt others))))
|
||||
(cond
|
||||
((null alts) (error "Please avoid it") (pcase--u rest))
|
||||
;; Yes, we can use `memq' (or `member')!
|
||||
;; Yes, we can use `memql' (or `member')!
|
||||
((> (length simples) 1)
|
||||
(pcase--u1 (cons `(match ,var
|
||||
. (pred (pcase--flip
|
||||
,(if memq-ok #'memq #'member)
|
||||
,(if memql-ok #'memql #'member)
|
||||
',simples)))
|
||||
(cdr matches))
|
||||
code vars
|
||||
|
|
|
|||
|
|
@ -51,11 +51,13 @@
|
|||
|
||||
(ert-deftest pcase-tests-member ()
|
||||
(should (pcase-tests-grep
|
||||
'memq (macroexpand-all '(pcase x ((or 1 2 3) body)))))
|
||||
'memql (macroexpand-all '(pcase x ((or 1 2 3) body)))))
|
||||
(should (pcase-tests-grep
|
||||
'member (macroexpand-all '(pcase x ((or "a" 2 3) 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)
|
||||
|
|
|
|||
Loading…
Reference in a new issue