[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 92ffe44 3/3: Body of dynamic let-bindings is not in tail position
From: |
Mattias Engdegård |
Subject: |
master 92ffe44 3/3: Body of dynamic let-bindings is not in tail position |
Date: |
Mon, 20 Dec 2021 10:33:29 -0500 (EST) |
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)