From 6f5475834a0862e93f9d6175bb1c4a56c287b93c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 2 Jan 2014 23:40:30 -0500 Subject: [PATCH] * lisp/emacs-lisp/pcase.el (pcase--split-equal, pcase--split-member): Beware signals raised by predicates. Fixes: debbugs:16201 --- lisp/ChangeLog | 13 +++++++++---- lisp/emacs-lisp/pcase.el | 26 ++++++++++++++------------ 2 files changed, 23 insertions(+), 16 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 570d900022f..4246fb3a535 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,9 +1,14 @@ +2014-01-03 Stefan Monnier + + * emacs-lisp/pcase.el (pcase--split-equal, pcase--split-member): + Beware signals raised by predicates (bug#16201). + 2014-01-02 Richard Stallman * 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 - * 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 diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 7f5a32c65bb..2cdb7b4987e 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -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)) -- 2.11.4.GIT