bug#64404: 30.0.50; condition-case-unless-debug mishandles :success

[Basil Contovounesios via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 274 bytes --]

Mattias Engdegård [2023-07-02 11:57 +0200] wrote:

> Good catch! I don't think we need to bother about the Lisp
> interpreter, but I added a byte-compiler warning for it in 59a350cb91.

Thanks.

> Would you like to repair condition-case-unless-debug?

Like so?


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Fix-condition-case-unless-debug-with-success.patch --]
[-- Type: text/x-diff, Size: 2120 bytes --]

From 8b47f52c81fe5d039a555f5037921f978191d2aa Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Mon, 3 Jul 2023 10:10:47 +0100
Subject: [PATCH] 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-success):
New test.
---
 lisp/subr.el            |  9 ++++++---
 test/lisp/subr-tests.el | 11 +++++++++++
 2 files changed, 17 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 @@ condition-case-unless-debug
   `(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..14caf54b380 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -1256,5 +1256,16 @@ subr--copy-tree
                              "((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-success ()
+  "Test `condition-case-unless-debug' with :success (bug#64404)."
+  (should (= 1 (condition-case-unless-debug nil
+                   0
+                 (:success 1)
+                 (t 2))))
+  (should (= 1 (condition-case-unless-debug var
+                   0
+                 (:success (1+ var))
+                 (t var)))))
+
 (provide 'subr-tests)
 ;;; subr-tests.el ends here
-- 
2.34.1


[-- Attachment #3: Type: text/plain, Size: 11 bytes --]


-- 
Basil