From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Fri, 23 Jun 2023 14:45:49 +0000 (-0400)
Subject: cl-defun/cl-struct: Use static scoping for function args
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=37a09a4c00e5f78c27f64ea09ec076838a1a3d47;p=emacs.git

cl-defun/cl-struct: Use static scoping for function args

* lisp/emacs-lisp/cl-macs.el (cl--slet*): New function.
(cl--transform-lambda): Use it to fix bug#47552.

* test/lisp/emacs-lisp/cl-macs-tests.el (cl-&key-arguments): Add test.
---

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 0b09cd7d225..007be1c9b08 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -243,6 +243,18 @@ The name is made by appending a number to PREFIX, default \"T\"."
 (defvar cl--bind-enquote)      ;Non-nil if &cl-quote was in the formal arglist!
 (defvar cl--bind-lets) (defvar cl--bind-forms)
 
+(defun cl--slet* (bindings body)
+  "Like `macroexp-let*' but uses static scoping for all the BINDINGS."
+  (pcase-exhaustive bindings
+    ('() body)
+    (`((,var ,exp) . ,bindings)
+     (let ((rest (cl--slet* bindings body)))
+       (if (macroexp--dynamic-variable-p var)
+           ;; FIXME: We use `identity' to obfuscate the code enough to
+           ;; circumvent the known bug in `macroexp--unfold-lambda' :-(
+           `(funcall (identity (lambda (,var) ,@(macroexp-unprogn rest))) ,exp)
+         (macroexp-let* `((,var ,exp)) rest))))))
+
 (defun cl--transform-lambda (form bind-block)
   "Transform a function form FORM of name BIND-BLOCK.
 BIND-BLOCK is the name of the symbol to which the function will be bound,
@@ -337,10 +349,12 @@ FORM is of the form (ARGS . BODY)."
                 (list '&rest (car (pop cl--bind-lets))))))))
       `((,@(nreverse simple-args) ,@rest-args)
         ,@header
-        ,(macroexp-let* cl--bind-lets
-                        (macroexp-progn
-                         `(,@(nreverse cl--bind-forms)
-                           ,@body)))))))
+        ;; Make sure that function arguments are unconditionally statically
+        ;; scoped (bug#47552).
+        ,(cl--slet* cl--bind-lets
+                    (macroexp-progn
+                     `(,@(nreverse cl--bind-forms)
+                       ,@body)))))))
 
 ;;;###autoload
 (defmacro cl-defun (name args &rest body)
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el
index a4bc8d542d4..44fc7264a0a 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -806,7 +806,15 @@ See Bug#57915."
 (ert-deftest cl-&key-arguments ()
   (cl-flet ((fn (&key x) x))
     (should-error (fn :x))
-    (should (eq (fn :x :a) :a))))
+    (should (eq (fn :x :a) :a)))
+  ;; In ELisp function arguments are always statically scoped (bug#47552).
+  (defvar cl--test-a)
+  (let ((cl--test-a 'dyn)
+        ;; FIXME: How do we silence the "Lexical argument shadows" warning?
+        (f (cl-function (lambda (&key cl--test-a b)
+                          (list cl--test-a (symbol-value 'cl--test-a) b)))))
+    (should (equal (funcall f :cl--test-a 'lex :b 2) '(lex dyn 2)))))
+
 
 
 ;;; cl-macs-tests.el ends here