From 92ffe44834b8f77ee3f4d37edfdb19f30a376869 Mon Sep 17 00:00:00 2001
From: Mattias Engdegård <mattiase@acm.org>
Date: Mon, 20 Dec 2021 11:59:22 +0100
Subject: Body of dynamic let-bindings is not in tail position

This fixes a known bug in `named-let`.

* lisp/emacs-lisp/cl-macs.el (cl--self-tco): Prevent TCO from inside
dynamic variable bindings.
* test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs--labels): Add test.
---
 lisp/emacs-lisp/cl-macs.el            | 11 ++++++++---
 test/lisp/emacs-lisp/cl-macs-tests.el | 19 ++++++++++++++++++-
 2 files changed, 26 insertions(+), 4 deletions(-)

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index f78fdcf0085..9e93e8775d5 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2139,9 +2139,14 @@ Like `cl-flet' but the definitions can refer to previous ones.
                    ;; setq the fresh new `ofargs' vars instead ;-)
                    (let ((shadowings
                           (mapcar (lambda (b) (if (consp b) (car b) b)) bindings)))
-                     ;; If `var' is shadowed, then it clearly can't be
-                     ;; tail-called any more.
-                     (not (memq var shadowings)))))
+                     (and
+                      ;; If `var' is shadowed, then it clearly can't be
+                      ;; tail-called any more.
+                      (not (memq var shadowings))
+                      ;; If any of the new bindings is a dynamic
+                      ;; variable, the body is not in tail position.
+                      (not (cl-some #'macroexp--dynamic-variable-p
+                                    shadowings))))))
              `(,(car exp) ,bindings . ,(funcall opt-exps exps)))
             ((and `(condition-case ,err-var ,bodyform . ,handlers)
                   (guard (not (eq err-var var))))
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el
index 13da60ec45e..ced2cc10f30 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -666,7 +666,24 @@ collection clause."
   (should (pcase (macroexpand
                   '(cl-labels ((len (xs n) (if xs (len (cdr xs) (1+ n)) n)))
                      #'len))
-            (`(function (lambda (,_ ,_) . ,_)) t))))
+            (`(function (lambda (,_ ,_) . ,_)) t)))
+
+  ;; Verify that there is no tail position inside dynamic variable bindings.
+  (defvar dyn-var)
+  (let ((dyn-var 'a))
+    (cl-labels ((f (x) (if x
+                           dyn-var
+                         (let ((dyn-var 'b))
+                           (f dyn-var)))))
+      (should (equal (f nil) 'b))))
+
+  ;; Control: same as above but with lexical binding.
+  (let ((lex-var 'a))
+    (cl-labels ((f (x) (if x
+                           lex-var
+                         (let ((lex-var 'b))
+                           (f lex-var)))))
+      (should (equal (f nil) 'a)))))
 
 (ert-deftest cl-macs--progv ()
   (defvar cl-macs--test)
-- 
cgit v1.2.3