Self-TCO in `condition-case` error handlers

* lisp/emacs-lisp/cl-macs.el (cl--self-tco): Recognise
`condition-case` handlers as being in the tail position.
* test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs--labels):
Extend test.

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 27ed07b66732c007acbc43df421da50bf1597fdb..68211ec41063159c06d80f7790896a71fd300c69 100644 (file)
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2141,6 +2141,13 @@ Like `cl-flet' but the definitions can refer to previous ones.
                      ;; tail-called any more.
                      (not (memq var shadowings)))))
              `(,(car exp) ,bindings . ,(funcall opt-exps exps)))
+            ((and `(condition-case ,err-var ,bodyform . ,handlers)
+                  (guard (not (eq err-var var))))
+             `(condition-case ,err-var
+                  (progn (setq ,retvar ,bodyform) nil)
+                . ,(mapcar (lambda (h)
+                             (cons (car h) (funcall opt-exps (cdr h))))
+                           handlers)))
             ('nil nil)  ;No need to set `retvar' to return nil.
             (_ `(progn (setq ,retvar ,exp) nil))))))
 

diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el
index dd6487603d3eb4dda687fb4aba97a4707399c8ca..5c3e603b92e10eed4ce4babed7b45a02f0ad0bee 100644 (file)
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -629,14 +629,24 @@ collection clause."
                           (let (n1)
                             (and xs
                                  (progn (setq n1 (1+ n))
-                                        (len2 (cdr xs) n1)))))))
+                                        (len2 (cdr xs) n1))))))
+         ;; Tail call in error handler.
+         (len3 (xs n)
+               (if xs
+                   (condition-case nil
+                       (/ 1 0)
+                     (arith-error (len3 (cdr xs) (1+ n))))
+                 n)))
       (should (equal (len nil 0) 0))
       (should (equal (len2 nil 0) 0))
+      (should (equal (len3 nil 0) 0))
       (should (equal (len list-42 0) 42))
       (should (equal (len2 list-42 0) 42))
+      (should (equal (len3 list-42 0) 42))
       ;; Should not bump into stack depth limits.
       (should (equal (len list-42k 0) 42000))
-      (should (equal (len2 list-42k 0) 42000))))
+      (should (equal (len2 list-42k 0) 42000))
+      (should (equal (len3 list-42k 0) 42000))))
 
   ;; Check that non-recursive functions are handled more efficiently.
   (should (pcase (macroexpand '(cl-labels ((f (x) (+ x 1))) (f 5)))