[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#64404: 30.0.50; condition-case-unless-debug mishandles :success
From: |
Basil Contovounesios |
Subject: |
bug#64404: 30.0.50; condition-case-unless-debug mishandles :success |
Date: |
Mon, 03 Jul 2023 10:24:04 +0100 |
User-agent: |
Gnus/5.13 (Gnus v5.13) |
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?
>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
--
Basil