branch: externals/compat
commit a9efb4a6c98da984a93df4a5d41d8d3e73459178
Author: Philip Kaludercic <phil...@posteo.net>
Commit: Philip Kaludercic <phil...@posteo.net>
compat-28: Fix 'named-let's TCO involving short-circuiting 'and'
---
compat-28.el | 8 ++++++--
compat-tests.el | 6 ++++++
2 files changed, 12 insertions(+), 2 deletions(-)
diff --git a/compat-28.el b/compat-28.el
index 9834044c19..2e89800234 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 b36eef8372..cff3ff2c84 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)
