aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorBasil L. Contovounesios2023-07-03 10:10:47 +0100
committerBasil L. Contovounesios2023-07-08 12:14:57 +0100
commit4c2cc21354a500b0fc48994b7b60648ef5f00a2d (patch)
tree4410a37d6683ebd37bb82976f2f8cf41bcd01dc7
parent375dac936fcca902874ecfd1c57b713581641725 (diff)
downloademacs-4c2cc21354a500b0fc48994b7b60648ef5f00a2d.tar.gz
emacs-4c2cc21354a500b0fc48994b7b60648ef5f00a2d.zip
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.
-rw-r--r--lisp/subr.el9
-rw-r--r--test/lisp/subr-tests.el31
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."
4987 `(condition-case ,var 4987 `(condition-case ,var
4988 ,bodyform 4988 ,bodyform
4989 ,@(mapcar (lambda (handler) 4989 ,@(mapcar (lambda (handler)
4990 `((debug ,@(if (listp (car handler)) (car handler) 4990 (let ((condition (car handler)))
4991 (list (car handler)))) 4991 (if (eq condition :success)
4992 ,@(cdr handler))) 4992 handler
4993 `((debug ,@(if (listp condition) condition
4994 (list condition)))
4995 ,@(cdr handler)))))
4993 handlers))) 4996 handlers)))
4994 4997
4995(defmacro with-demoted-errors (format &rest body) 4998(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."))
1256 "((a b) (a b) #2# #2# #3# #3#)" 1256 "((a b) (a b) #2# #2# #3# #3#)"
1257 "((a b) (a b) [c d] [c d] #s(e f) #s(e f))"))))))) 1257 "((a b) (a b) [c d] [c d] #s(e f) #s(e f))")))))))
1258 1258
1259(ert-deftest condition-case-unless-debug ()
1260 "Test `condition-case-unless-debug'."
1261 (let ((debug-on-error nil))
1262 (with-suppressed-warnings ((suspicious condition-case))
1263 (should (= 0 (condition-case-unless-debug nil 0))))
1264 (should (= 0 (condition-case-unless-debug nil 0 (t 1))))
1265 (should (= 0 (condition-case-unless-debug x 0 (t (1+ x)))))
1266 (should (= 1 (condition-case-unless-debug nil (error "") (t 1))))
1267 (should (equal (condition-case-unless-debug x (error "") (t x))
1268 '(error "")))))
1269
1270(ert-deftest condition-case-unless-debug-success ()
1271 "Test `condition-case-unless-debug' with :success (bug#64404)."
1272 (let ((debug-on-error nil))
1273 (should (= 1 (condition-case-unless-debug nil 0 (:success 1))))
1274 (should (= 1 (condition-case-unless-debug nil 0 (:success 1) (t 2))))
1275 (should (= 1 (condition-case-unless-debug nil 0 (t 2) (:success 1))))
1276 (should (= 1 (condition-case-unless-debug x 0 (:success (1+ x)))))
1277 (should (= 1 (condition-case-unless-debug x 0 (:success (1+ x)) (t x))))
1278 (should (= 1 (condition-case-unless-debug x 0 (t x) (:success (1+ x)))))
1279 (should (= 2 (condition-case-unless-debug nil (error "")
1280 (:success 1) (t 2))))
1281 (should (= 2 (condition-case-unless-debug nil (error "")
1282 (t 2) (:success 1))))
1283 (should (equal (condition-case-unless-debug x (error "")
1284 (:success (1+ x)) (t x))
1285 '(error "")))
1286 (should (equal (condition-case-unless-debug x (error "")
1287 (t x) (:success (1+ x)))
1288 '(error "")))))
1289
1259(provide 'subr-tests) 1290(provide 'subr-tests)
1260;;; subr-tests.el ends here 1291;;; subr-tests.el ends here