master 4c2cc21354a: Fix condition-case-unless-debug with :success

[Basil L. Contovounesios]

branch: master
commit 4c2cc21354a500b0fc48994b7b60648ef5f00a2d
Author: Basil L. Contovounesios <contovob@tcd.ie>
Commit: Basil L. Contovounesios <contovob@tcd.ie>

    Fix condition-case-unless-debug with :success
    
    * lisp/subr.el (condition-case-unless-debug): Don't add debug
    condition to :success handler (bug#64404).
    * test/lisp/subr-tests.el (condition-case-unless-debug)
    (condition-case-unless-debug-success): New tests.
---
 lisp/subr.el            |  9 ++++++---
 test/lisp/subr-tests.el | 31 +++++++++++++++++++++++++++++++
 2 files changed, 37 insertions(+), 3 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index 4c462830120..483083b29c3 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -4987,9 +4987,12 @@ even if this catches the signal."
   `(condition-case ,var
        ,bodyform
      ,@(mapcar (lambda (handler)
-                 `((debug ,@(if (listp (car handler)) (car handler)
-                              (list (car handler))))
-                   ,@(cdr handler)))
+                 (let ((condition (car handler)))
+                   (if (eq condition :success)
+                       handler
+                     `((debug ,@(if (listp condition) condition
+                                  (list condition)))
+                       ,@(cdr handler)))))
                handlers)))
 
 (defmacro with-demoted-errors (format &rest body)
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 1c220b1da18..0d409cead26 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -1256,5 +1256,36 @@ final or penultimate step during initialization."))
                              "((a b) (a b) #2# #2# #3# #3#)"
                              "((a b) (a b) [c d] [c d] #s(e f) #s(e f))")))))))
 
+(ert-deftest condition-case-unless-debug ()
+  "Test `condition-case-unless-debug'."
+  (let ((debug-on-error nil))
+    (with-suppressed-warnings ((suspicious condition-case))
+      (should (= 0 (condition-case-unless-debug nil 0))))
+    (should (= 0 (condition-case-unless-debug nil 0 (t 1))))
+    (should (= 0 (condition-case-unless-debug x 0 (t (1+ x)))))
+    (should (= 1 (condition-case-unless-debug nil (error "") (t 1))))
+    (should (equal (condition-case-unless-debug x (error "") (t x))
+                   '(error "")))))
+
+(ert-deftest condition-case-unless-debug-success ()
+  "Test `condition-case-unless-debug' with :success (bug#64404)."
+  (let ((debug-on-error nil))
+    (should (= 1 (condition-case-unless-debug nil 0 (:success 1))))
+    (should (= 1 (condition-case-unless-debug nil 0 (:success 1) (t 2))))
+    (should (= 1 (condition-case-unless-debug nil 0 (t 2) (:success 1))))
+    (should (= 1 (condition-case-unless-debug x 0 (:success (1+ x)))))
+    (should (= 1 (condition-case-unless-debug x 0 (:success (1+ x)) (t x))))
+    (should (= 1 (condition-case-unless-debug x 0 (t x) (:success (1+ x)))))
+    (should (= 2 (condition-case-unless-debug nil (error "")
+                   (:success 1) (t 2))))
+    (should (= 2 (condition-case-unless-debug nil (error "")
+                   (t 2) (:success 1))))
+    (should (equal (condition-case-unless-debug x (error "")
+                     (:success (1+ x)) (t x))
+                   '(error "")))
+    (should (equal (condition-case-unless-debug x (error "")
+                     (t x) (:success (1+ x)))
+                   '(error "")))))
+
 (provide 'subr-tests)
 ;;; subr-tests.el ends here