compat-28: Fix 'named-let's TCO involving short-circuiting 'and'

2 files changed, 12 insertions, 2 deletions

diff --git a/compat-28.el b/compat-28.el
index 9834044..2e89800 100644
--- a/compat-28.el
+++ b/compat-28.el
@@ -518,8 +518,12 @@ as the new values of the bound variables in the recursive invocation."
                              (cons (car handler)
                                    (funcall tco-progn (cdr handler))))
                            (nthcdr 3 expr))))
-                 ((memq (car-safe expr) '(and progn))
-                  (cons (car expr) (funcall tco-progn (cdr expr))))
+                 ((eq (car-safe expr) 'and)
+		  (if (cddr expr)
+		      (funcall tco `(if ,(cadr expr) ,(cons 'and (cddr expr))))
+                    (funcall tco (cadr expr))))
+		 ((eq (car-safe expr) 'progn)
+		  (cons (car expr) (funcall tco-progn (cdr expr))))
                  ((memq (car-safe expr) '(let let*))
                   (append (list (car expr) (cadr expr))
                           (funcall tco-progn (cddr expr))))
diff --git a/compat-tests.el b/compat-tests.el
index b36eef8..cff3ff2 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -2447,6 +2447,12 @@
                   (cond ((= x 0) 'ok)
                         ((and t (lop (1- x))))))
                 'ok)
+  (should-equal (let ((n 0))
+                  (named-let lop ((l '(1 2 3)))
+                    (setq n (1+ n))
+                    (and l (lop (cdr l))))
+                  n)
+                4)
   (should-equal (let ((b t))
                   (named-let lop ((i 0))
                     (cond ((null i) nil) ((= i 10000) 'ok)