master 92ffe44 3/3: Body of dynamic let-bindings is not in tail position

[Mattias Engdegård]

branch: master
commit 92ffe44834b8f77ee3f4d37edfdb19f30a376869
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    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 f78fdcf..9e93e87 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 13da60e..ced2cc1 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)