procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* 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
Show stats 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>
* dired-aux.el (dired-do-print): Handle printer-name.
* mail/rmailmm.el (rmail-mime-message-p): Moved to rmail.el.
* mail/rmail.el (rmail-mime-message-p): Moved from rmailmm.el.
* mail/rmailmm.el (rmail-mime-message-p): Move to rmail.el.
* mail/rmail.el (rmail-mime-message-p): Move from rmailmm.el.
(rmail-epa-decrypt): Turn off mime processing.
* mail/rmail.el (rmail-make-in-reply-to-field):
@ -65,8 +70,8 @@
2013-12-28 João Távora <joaotavora@gmail.com>
* elec-pair.el (electric-pair-post-self-insert-function): Don't
open extra newlines at beginning of buffer. (Bug#16272)
* elec-pair.el (electric-pair-post-self-insert-function):
Don't open extra newlines at beginning of buffer. (Bug#16272)
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)
(symbolp (cadr pat))
(get (cadr pat) 'side-effect-free))
(if (funcall (cadr pat) elem)
'(:pcase--succeed . nil)
'(:pcase--fail . nil)))))
(ignore-errors
(if (funcall (cadr pat) elem)
'(:pcase--succeed . nil)
'(:pcase--fail . nil))))))
(defun pcase--split-member (elems pat)
;; 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)
(symbolp (cadr pat))
(get (cadr pat) 'side-effect-free)
(let ((p (cadr pat)) (all t))
(dolist (elem elems)
(unless (funcall p elem) (setq all nil)))
all))
(ignore-errors
(let ((p (cadr pat)) (all t))
(dolist (elem elems)
(unless (funcall p elem) (setq all nil)))
all)))
'(:pcase--succeed . nil))))
(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).
(macroexp-let*
`(,@(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)
(pcase--u else-rest))))
((or (integerp qpat) (symbolp qpat) (stringp qpat))
(let* ((splitrest (pcase--split-rest
sym (lambda (pat) (pcase--split-equal qpat pat)) rest))
(then-rest (car splitrest))
(else-rest (cdr splitrest)))
(let* ((splitrest (pcase--split-rest
sym (lambda (pat) (pcase--split-equal qpat pat)) rest))
(then-rest (car splitrest))
(else-rest (cdr splitrest)))
(pcase--if (cond
((stringp qpat) `(equal ,sym ,qpat))
((null qpat) `(null ,sym))