[elpa] externals/compat 06803eb 1/2: Rewrite TCO for condition-case

[ELPA Syncer]

branch: externals/compat
commit 06803ebd7dffa071d8da14c3b4340c09b9f0d66c
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>

    Rewrite TCO for condition-case
    
    Issue and tests contributed by Mattias Engdegård.
---
 compat-28.1.el  |  9 ++++++---
 compat-tests.el | 26 +++++++++++++++-----------
 2 files changed, 21 insertions(+), 14 deletions(-)

diff --git a/compat-28.1.el b/compat-28.1.el
index 56a6e1c..d164bad 100644
--- a/compat-28.1.el
+++ b/compat-28.1.el
@@ -443,9 +443,12 @@ as the new values of the bound variables in the recursive 
invocation."
                              ,(funcall tco (cons 'or (cddr expr))))))
                     (funcall tco (cadr expr))))
                  ((eq (car-safe expr) 'condition-case)
-                  (append (list 'condition-case (cadr expr)
-                                (funcall tco (caddr expr)))
-                          (cdddr expr)))
+                  (append (list 'condition-case (cadr expr) (caddr expr))
+                          (mapcar
+                           (lambda (handler)
+                             (cons (car handler)
+                                   (funcall tco-progn (cdr handler))))
+                           (cdddr expr))))
                  ((memq (car-safe expr) '(and progn))
                   (cons (car expr) (funcall tco-progn (cdr expr))))
                  ((memq (car-safe expr) '(let let*))
diff --git a/compat-tests.el b/compat-tests.el
index 6c1f36d..ca77efd 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -1194,16 +1194,6 @@ the compatibility function."
   (should (= (compat--named-let l ((i 0)) (if (= i 100000) i (l (1+ i))))
              100000))
   (should (= (compat--named-let l ((i 0))
-               (condition-case nil
-                   (if (= i 100000) i (l (1+ i)))
-                 (error nil)))
-             100000))
-  (should (= (compat--named-let l ((i 0))
-               (condition-case nil
-                   (if (= i 100000) i (l (1+ i)))
-                 (error nil)))
-             100000))
-  (should (= (compat--named-let l ((i 0))
                (cond
                 ((= i 100000) i)
                 ((= (mod i 2) 0)
@@ -1211,7 +1201,21 @@ the compatibility function."
                 ((l (+ i 3)))))
              100000))
   (should (= (compat--named-let l ((i 0) (x 1)) (if (= i 8) x (l (1+ i) (* x 
2))))
-             (expt 2 8))))
+             (expt 2 8)))
+  (should (eq (compat--named-let loop ((x 1))
+                (if (> x 0)
+                    (condition-case nil
+                        (loop (1- x))
+                      (arith-error 'ok))
+                  (/ 1 x)))
+              'ok))
+  (should (eq (compat--named-let loop ((n 10000))
+                (if (> n 0)
+                    (condition-case nil
+                        (/ n 0)
+                      (arith-error (loop (1- n))))
+                  'ok))
+              'ok)))
 
 (ert-deftest compat-directory-name-p ()
   "Check if `compat--directory-name-p' was implemented properly."