[elpa] externals/compat 5256e51 2/4: Fix TCO for cond when a condition only had a head

[ELPA Syncer]

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

    Fix TCO for cond when a condition only had a head
---
 compat-28.1.el  | 12 +++++++-----
 compat-tests.el | 17 +++++++++++++++++
 2 files changed, 24 insertions(+), 5 deletions(-)

diff --git a/compat-28.1.el b/compat-28.1.el
index de49bad..56a6e1c 100644
--- a/compat-28.1.el
+++ b/compat-28.1.el
@@ -428,11 +428,13 @@ as the new values of the bound variables in the recursive 
invocation."
                           (funcall tco-progn (cdddr expr))))
                  ((eq (car-safe expr) 'cond)
                   (cons 'cond
-                        (mapcar (lambda (branch)
-                                  (list
-                                   (car branch)
-                                   (funcall tco-progn (cdr expr))))
-                                (cdr expr))))
+                        (mapcar
+                         (lambda (branch)
+                           (if (cdr branch)
+                               (cons (car branch)
+                                     (funcall tco-progn (cdr branch)))
+                             (list `(progn ,(funcall tco (car branch)) t))))
+                         (cdr expr))))
                  ((eq (car-safe expr) 'or)
                   (if (cddr expr)
                       (let ((var (make-symbol "var")))
diff --git a/compat-tests.el b/compat-tests.el
index b422c75..333f9d0 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -1221,6 +1221,23 @@ the compatibility function."
              8))
   (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)
+                 (l (+ i 2)))
+                ((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))))