mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 22:41:06 -08:00
Code Issues Projects Releases Wiki Activity

* lisp/emacs-lisp/pcase.el (pcase--split-equal, pcase--split-member):

Browse source 
Beware signals raised by predicates.

Fixes: debbugs:16201
This commit is contained in:
Stefan Monnier 2014-01-02 23:40:30 -05:00
parent ba05e912ae
commit 6f5475834a
2 changed files with 23 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

13
lisp/ChangeLog
View file

@ -1,9 +1,14 @@
2014-01-03 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/pcase.el (pcase--split-equal, pcase--split-member):
Beware signals raised by predicates (bug#16201).
2014-01-02 Richard Stallman <rms@gnu.org> 2014-01-02 Richard Stallman <rms@gnu.org>
* dired-aux.el (dired-do-print): Handle printer-name. * dired-aux.el (dired-do-print): Handle printer-name.
* mail/rmailmm.el (rmail-mime-message-p): Moved to rmail.el. * mail/rmailmm.el (rmail-mime-message-p): Move to rmail.el.
* mail/rmail.el (rmail-mime-message-p): Moved from rmailmm.el. * mail/rmail.el (rmail-mime-message-p): Move from rmailmm.el.
(rmail-epa-decrypt): Turn off mime processing. (rmail-epa-decrypt): Turn off mime processing.
* mail/rmail.el (rmail-make-in-reply-to-field): * mail/rmail.el (rmail-make-in-reply-to-field):
@ -65,8 +70,8 @@
2013-12-28 João Távora <joaotavora@gmail.com> 2013-12-28 João Távora <joaotavora@gmail.com>
* elec-pair.el (electric-pair-post-self-insert-function): Don't * elec-pair.el (electric-pair-post-self-insert-function):
open extra newlines at beginning of buffer. (Bug#16272) Don't open extra newlines at beginning of buffer. (Bug#16272)
2013-12-28 Eli Zaretskii <eliz@gnu.org> 2013-12-28 Eli Zaretskii <eliz@gnu.org>

26
lisp/emacs-lisp/pcase.el
View file

@ -461,9 +461,10 @@ MATCH is the pattern that needs to be matched, of the form:
((and (eq (car-safe pat) 'pred) ((and (eq (car-safe pat) 'pred)
(symbolp (cadr pat)) (symbolp (cadr pat))
(get (cadr pat) 'side-effect-free)) (get (cadr pat) 'side-effect-free))
(if (funcall (cadr pat) elem) (ignore-errors
'(:pcase--succeed . nil) (if (funcall (cadr pat) elem)
'(:pcase--fail . nil))))) '(:pcase--succeed . nil)
'(:pcase--fail . nil))))))
(defun pcase--split-member (elems pat) (defun pcase--split-member (elems pat)
;; Based on pcase--split-equal. ;; Based on pcase--split-equal.
@ -484,10 +485,11 @@ MATCH is the pattern that needs to be matched, of the form:
((and (eq (car-safe pat) 'pred) ((and (eq (car-safe pat) 'pred)
(symbolp (cadr pat)) (symbolp (cadr pat))
(get (cadr pat) 'side-effect-free) (get (cadr pat) 'side-effect-free)
(let ((p (cadr pat)) (all t)) (ignore-errors
(dolist (elem elems) (let ((p (cadr pat)) (all t))
(unless (funcall p elem) (setq all nil))) (dolist (elem elems)
all)) (unless (funcall p elem) (setq all nil)))
all)))
'(:pcase--succeed . nil)))) '(:pcase--succeed . nil))))
(defun pcase--split-pred (vars upat pat) (defun pcase--split-pred (vars upat pat)
@ -761,14 +763,14 @@ Otherwise, it defers to REST which is a list of branches of the form
;; `then-body', but only within some sub-branch). ;; `then-body', but only within some sub-branch).
(macroexp-let* (macroexp-let*
`(,@(if (get syma 'pcase-used) `((,syma (car ,sym)))) `(,@(if (get syma 'pcase-used) `((,syma (car ,sym))))
,@(if (get symd 'pcase-used) `((,symd (cdr ,sym))))) ,@(if (get symd 'pcase-used) `((,symd (cdr ,sym)))))
then-body) then-body)
(pcase--u else-rest)))) (pcase--u else-rest))))
((or (integerp qpat) (symbolp qpat) (stringp qpat)) ((or (integerp qpat) (symbolp qpat) (stringp qpat))
(let* ((splitrest (pcase--split-rest (let* ((splitrest (pcase--split-rest
sym (lambda (pat) (pcase--split-equal qpat pat)) rest)) sym (lambda (pat) (pcase--split-equal qpat pat)) rest))
(then-rest (car splitrest)) (then-rest (car splitrest))
(else-rest (cdr splitrest))) (else-rest (cdr splitrest)))
(pcase--if (cond (pcase--if (cond
((stringp qpat) `(equal ,sym ,qpat)) ((stringp qpat) `(equal ,sym ,qpat))
((null qpat) `(null ,sym)) ((null qpat) `(null ,sym))