[Emacs-diffs] trunk r115851: * lisp/emacs-lisp/pcase.el (pcase--split-equal, pcase--split-member):

[Stefan Monnier]

------------------------------------------------------------
revno: 115851
revision-id: address@hidden
parent: address@hidden
fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=16201
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Thu 2014-01-02 23:40:30 -0500
message:
  * lisp/emacs-lisp/pcase.el (pcase--split-equal, pcase--split-member):
  Beware signals raised by predicates.
modified:
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/emacs-lisp/pcase.el       pcase.el-20100810123717-8zwve3391p2ywm1h-1

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2014-01-02 22:54:37 +0000
+++ b/lisp/ChangeLog    2014-01-03 04:40:30 +0000
@@ -1,9 +1,14 @@
+2014-01-03  Stefan Monnier  <address@hidden>
+
+       * emacs-lisp/pcase.el (pcase--split-equal, pcase--split-member):
+       Beware signals raised by predicates (bug#16201).
+
 2014-01-02  Richard Stallman  <address@hidden>
 
        * 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  <address@hidden>
 
-       * 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  <address@hidden>
 

=== modified file 'lisp/emacs-lisp/pcase.el'
--- a/lisp/emacs-lisp/pcase.el  2014-01-01 07:43:34 +0000
+++ b/lisp/emacs-lisp/pcase.el  2014-01-03 04:40:30 +0000
@@ -461,9 +461,10 @@
    ((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 @@
    ((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 @@
        ;; `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))