Add `macroexp--dynamic-variable-p`

This predicate can be used for discriminating between lexically and
dynamically bound variables during macro-expansion (only).
It is restricted to internal use for the time being.

* lisp/emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment):
Use macroexpand--all-toplevel.
* lisp/emacs-lisp/macroexp.el (macroexp-dynamic-variable-p): New.
(macroexp--expand-all): Maintain macroexp--dynvars.
(macroexpand-all): Rebind macroexp--dynvars.
(macroexpand--all-toplevel): New.
(internal-macroexpand-for-load): Use macroexpand--all-toplevel.
* src/eval.c (eval_sub): Transfer defvar declarations from
Vinternal_interpreter_environment into macroexp--dynvars during
lazy macro-expansion.
* src/lread.c (readevalloop): Rebind macroexp--dynvars around
read-and-evaluate operations.
(syms_of_lread): Define macroexp--dynvars.
* test/lisp/emacs-lisp/macroexp-resources/vk.el: New file.
* test/lisp/emacs-lisp/macroexp-tests.el (macroexp-tests--run-emacs)
(macroexp-tests--eval-in-subprocess)
(macroexp-tests--byte-compile-in-subprocess)
(macroexp--tests-dynamic-variable-p): Add tests.

2 files changed, 182 insertions, 1 deletions

diff --git a/test/lisp/emacs-lisp/macroexp-resources/vk.el b/test/lisp/emacs-lisp/macroexp-resources/vk.el
new file mode 100644
index 00000000000..8bbd94ac666
--- /dev/null
+++ b/test/lisp/emacs-lisp/macroexp-resources/vk.el
@@ -0,0 +1,126 @@
+;;; vk.el --- test code for macroexp-tests    -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021  Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+(require 'macroexp)
+
+(defmacro vk-variable-kind (var)
+  (if (macroexp--dynamic-variable-p var) ''dyn ''lex))
+
+(defvar vk-a 1)
+(defconst vk-b 2)
+(defvar vk-c)
+
+(defun vk-f1 (x)
+  (defvar vk-u1)
+  (let ((vk-a 10)
+        (vk-b 20)
+        (vk-c 30)
+        (vk-u1 40)
+        (y 50))
+    (ignore vk-a vk-b vk-c vk-u1 x y)
+    (list
+     (vk-variable-kind vk-a)            ; dyn
+     (vk-variable-kind vk-b)            ; dyn
+     (vk-variable-kind vk-c)            ; dyn
+     (vk-variable-kind vk-u1)           ; dyn
+     (vk-variable-kind x)               ; lex
+     (vk-variable-kind y))))            ; lex
+
+(eval-and-compile
+  (defvar vk-u2)
+  (defun vk-f2 (x)
+    (defvar vk-v2)
+    (let ((vk-u2 11)
+          (vk-v2 12)
+          (y 13))
+      (ignore vk-u2 vk-v2 x y)
+      (list
+       (vk-variable-kind vk-u2)          ; dyn
+       (vk-variable-kind vk-v2)          ; dyn
+       (vk-variable-kind x)              ; lex
+       (vk-variable-kind y)))))          ; lex
+
+(eval-when-compile
+  (defvar vk-u3)
+  (defun vk-f3 (x)
+    (defvar vk-v3)
+    (let ((vk-a 23)
+          (vk-b 24)
+          (vk-u3 25)
+          (vk-v3 26)
+          (y 27))
+      (ignore vk-a vk-b vk-u3 vk-v3 x y)
+      (list
+       (vk-variable-kind vk-a)          ; dyn
+       (vk-variable-kind vk-b)          ; dyn
+       (vk-variable-kind vk-u3)         ; dyn
+       (vk-variable-kind vk-v3)         ; dyn
+       (vk-variable-kind x)             ; lex
+       (vk-variable-kind y)))))         ; lex
+
+(defconst vk-val3 (eval-when-compile (vk-f3 0)))
+
+(defconst vk-f4 '(lambda (x)
+                   (defvar vk-v4)
+                   (let ((vk-v4 31)
+                         (y 32))
+                     (ignore vk-v4 x y)
+                     (list
+                      (vk-variable-kind vk-a)   ; dyn
+                      (vk-variable-kind vk-b)   ; dyn
+                      (vk-variable-kind vk-v4)  ; dyn
+                      (vk-variable-kind x)      ; dyn
+                      (vk-variable-kind y)))))  ; dyn
+
+(defconst vk-f5 '(closure (t) (x)
+                   (defvar vk-v5)
+                   (let ((vk-v5 41)
+                         (y 42))
+                     (ignore vk-v5 x y)
+                     (list
+                      (vk-variable-kind vk-a)   ; dyn
+                      (vk-variable-kind vk-b)   ; dyn
+                      (vk-variable-kind vk-v5)  ; dyn
+                      (vk-variable-kind x)      ; lex
+                      (vk-variable-kind y)))))  ; lex
+
+(defun vk-f6 ()
+  (eval '(progn
+           (defvar vk-v6)
+           (let ((vk-v6 51)
+                 (y 52))
+             (ignore vk-v6 y)
+             (list
+              (vk-variable-kind vk-a)        ; dyn
+              (vk-variable-kind vk-b)        ; dyn
+              (vk-variable-kind vk-v6)       ; dyn
+              (vk-variable-kind vk-y))))))   ; dyn
+
+(defun vk-f7 ()
+  (eval '(progn
+           (defvar vk-v7)
+           (let ((vk-v7 51)
+                 (y 52))
+             (ignore vk-v7 y)
+             (list
+              (vk-variable-kind vk-a)        ; dyn
+              (vk-variable-kind vk-b)        ; dyn
+              (vk-variable-kind vk-v7)       ; dyn
+              (vk-variable-kind vk-y))))     ; lex
+        t))
+
+(provide 'vk)
diff --git a/test/lisp/emacs-lisp/macroexp-tests.el b/test/lisp/emacs-lisp/macroexp-tests.el
index 89d3882d1da..292c11ac6cd 100644
--- a/test/lisp/emacs-lisp/macroexp-tests.el
+++ b/test/lisp/emacs-lisp/macroexp-tests.el
@@ -24,6 +24,9 @@
 
 ;;; Code:
 
+(require 'macroexp)
+(require 'ert-x)
+
 (ert-deftest macroexp--tests-fgrep ()
   (should (equal (macroexp--fgrep '((x) (y)) '([x] z ((u))))
                  '((x))))
@@ -67,6 +70,58 @@
     (should (equal "m1.el"
                    (file-name-nondirectory macroexp--m1-tests-comp-filename)))))
 
+(defun macroexp-tests--run-emacs (&rest args)
+  "Run Emacs in batch mode with ARGS, return output."
+  (let ((emacs (expand-file-name invocation-name invocation-directory)))
+    (with-temp-buffer
+      (let ((res (apply #'call-process emacs nil t nil
+                        "-Q" "--batch" args))
+            (output (buffer-string)))
+        (unless (equal res 0)
+          (message "%s" output)
+          (error "Inferior Emacs exited with status %S" res))
+        output))))
+
+(defun macroexp-tests--eval-in-subprocess (file expr)
+  (let ((output (macroexp-tests--run-emacs
+                 "-l" file (format "--eval=(print %S)" expr))))
+    (car (read-from-string output))))
+
+(defun macroexp-tests--byte-compile-in-subprocess (file)
+  "Byte-compile FILE using a subprocess to avoid contaminating the lisp state."
+  (let ((output (macroexp-tests--run-emacs "-f" "batch-byte-compile" file)))
+    (when output
+      (message "%s" output))))
+
+(ert-deftest macroexp--tests-dynamic-variable-p ()
+  "Test `macroexp--dynamic-variable-p'."
+  (let* ((vk-el (ert-resource-file "vk.el"))
+         (vk-elc (concat vk-el "c"))
+         (expr '(list (vk-f1 0)
+                      (vk-f2 0)
+                      vk-val3
+                      (funcall vk-f4 0)
+                      (funcall vk-f5 0)
+                      (vk-f6)
+                      (vk-f7))))
+    ;; We compile and run the test in separate processes for complete
+    ;; isolation between test cases.
+    (should (equal (macroexp-tests--eval-in-subprocess vk-el expr)
+                   '((dyn dyn dyn dyn lex lex)
+                     (dyn dyn lex lex)
+                     (dyn dyn dyn dyn lex lex)
+                     (dyn dyn dyn dyn dyn)
+                     (dyn dyn dyn lex lex)
+                     (dyn dyn dyn dyn)
+                     (dyn dyn dyn lex))))
+    (macroexp-tests--byte-compile-in-subprocess vk-el)
+    (should (equal (macroexp-tests--eval-in-subprocess vk-elc expr)
+                   '((dyn dyn dyn dyn lex lex)
+                     (dyn dyn lex lex)
+                     (dyn dyn dyn dyn lex lex)
+                     (dyn dyn dyn dyn dyn)
+                     (dyn dyn dyn lex lex)
+                     (dyn dyn dyn dyn)
+                     (dyn dyn dyn lex))))))
 
-(provide 'macroexp-tests)
 ;;; macroexp-tests.el ends here