procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix condition-case-unless-debug with :success

Browse source 
* 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.
This commit is contained in:
Basil L. Contovounesios 2023-07-03 10:10:47 +01:00
parent 375dac936f
commit 4c2cc21354
2 changed files with 37 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
lisp/subr.el
View file

@ -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)

31
test/lisp/subr-tests.el
View file

@ -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