diff options
| author | Basil L. Contovounesios | 2023-07-03 10:10:47 +0100 |
|---|---|---|
| committer | Basil L. Contovounesios | 2023-07-08 12:14:57 +0100 |
| commit | 4c2cc21354a500b0fc48994b7b60648ef5f00a2d (patch) | |
| tree | 4410a37d6683ebd37bb82976f2f8cf41bcd01dc7 | |
| parent | 375dac936fcca902874ecfd1c57b713581641725 (diff) | |
| download | emacs-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.el | 9 | ||||
| -rw-r--r-- | 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." | |||
| 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 |