master a0f6029: Fix misuses of `byte-compile-macro-environment`

[Stefan Monnier]

branch: master
commit a0f60293d97cda858c033db4ae074e5e5560aab2
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    Fix misuses of `byte-compile-macro-environment`
    
    These seem to be left overs from Emacs<24 when `macroexpand-all` was
    implemented in the CL library and hence the macros's evaluation
    environment could come from different places depending on the
    circumstance (either `byte-compile-macro-environment`, or
    `cl-macro-environment`, or ...).
    
    `byte-compile-macro-environment` contains definitions which expand to
    code that is only understood by the rest of the byte-compiler,
    so using it for code which isn't being byte-compiled leads to errors
    such as references to non-existing function
    `internal--with-suppressed-warnings`.
    
    * lisp/emacs-lisp/cl-extra.el (cl-prettyexpand): Remove left-over
    binding from when `macroexpand-all` was implemented in the CL library.
    
    * lisp/emacs-lisp/ert.el (ert--expand-should-1):
    * lisp/emacs-lisp/cl-macs.el (cl--compile-time-too): Properly preserve the
    macroexpand-all-environment.
    (cl--macroexp-fboundp): Pay attention to `cl-macrolet` macros as well.
---
 lisp/emacs-lisp/cl-extra.el | 23 +++++++++++------------
 lisp/emacs-lisp/cl-macs.el  |  9 ++++-----
 lisp/emacs-lisp/ert.el      | 13 +++----------
 3 files changed, 18 insertions(+), 27 deletions(-)

diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 84199c1..eabba27 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -94,7 +94,7 @@ strings case-insensitively."
 (defun cl--mapcar-many (cl-func cl-seqs &optional acc)
   (if (cdr (cdr cl-seqs))
       (let* ((cl-res nil)
-            (cl-n (apply 'min (mapcar 'length cl-seqs)))
+            (cl-n (apply #'min (mapcar #'length cl-seqs)))
             (cl-i 0)
             (cl-args (copy-sequence cl-seqs))
             cl-p1 cl-p2)
@@ -131,7 +131,7 @@ strings case-insensitively."
   "Map a FUNCTION across one or more SEQUENCEs, returning a sequence.
 TYPE is the sequence type to return.
 \n(fn TYPE FUNCTION SEQUENCE...)"
-  (let ((cl-res (apply 'cl-mapcar cl-func cl-seq cl-rest)))
+  (let ((cl-res (apply #'cl-mapcar cl-func cl-seq cl-rest)))
     (and cl-type (cl-coerce cl-res cl-type))))
 
 ;;;###autoload
@@ -190,14 +190,14 @@ the elements themselves.
   "Like `cl-mapcar', but nconc's together the values returned by the function.
 \n(fn FUNCTION SEQUENCE...)"
   (if cl-rest
-      (apply 'nconc (apply 'cl-mapcar cl-func cl-seq cl-rest))
+      (apply #'nconc (apply #'cl-mapcar cl-func cl-seq cl-rest))
     (mapcan cl-func cl-seq)))
 
 ;;;###autoload
 (defun cl-mapcon (cl-func cl-list &rest cl-rest)
   "Like `cl-maplist', but nconc's together the values returned by the function.
 \n(fn FUNCTION LIST...)"
-  (apply 'nconc (apply 'cl-maplist cl-func cl-list cl-rest)))
+  (apply #'nconc (apply #'cl-maplist cl-func cl-list cl-rest)))
 
 ;;;###autoload
 (defun cl-some (cl-pred cl-seq &rest cl-rest)
@@ -236,13 +236,13 @@ non-nil value.
 (defun cl-notany (cl-pred cl-seq &rest cl-rest)
   "Return true if PREDICATE is false of every element of SEQ or SEQs.
 \n(fn PREDICATE SEQ...)"
-  (not (apply 'cl-some cl-pred cl-seq cl-rest)))
+  (not (apply #'cl-some cl-pred cl-seq cl-rest)))
 
 ;;;###autoload
 (defun cl-notevery (cl-pred cl-seq &rest cl-rest)
   "Return true if PREDICATE is false of some element of SEQ or SEQs.
 \n(fn PREDICATE SEQ...)"
-  (not (apply 'cl-every cl-pred cl-seq cl-rest)))
+  (not (apply #'cl-every cl-pred cl-seq cl-rest)))
 
 ;;;###autoload
 (defun cl--map-keymap-recursively (cl-func-rec cl-map &optional cl-base)
@@ -693,12 +693,11 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
   "Expand macros in FORM and insert the pretty-printed result."
   (declare (advertised-calling-convention (form) "27.1"))
   (message "Expanding...")
-  (let ((byte-compile-macro-environment nil))
-    (setq form (macroexpand-all form))
-    (message "Formatting...")
-    (prog1
-        (cl-prettyprint form)
-      (message ""))))
+  (setq form (macroexpand-all form))
+  (message "Formatting...")
+  (prog1
+      (cl-prettyprint form)
+    (message "")))
 
 ;;; Integration into the online help system.
 
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 007466b..91146c4 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -723,7 +723,7 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or 
at non-top-level.
 (defun cl--compile-time-too (form)
   (or (and (symbolp (car-safe form)) (get (car-safe form) 'byte-hunk-handler))
       (setq form (macroexpand
-                 form (cons '(cl-eval-when) byte-compile-macro-environment))))
+                 form (cons '(cl-eval-when) macroexpand-all-environment))))
   (cond ((eq (car-safe form) 'progn)
         (cons 'progn (mapcar #'cl--compile-time-too (cdr form))))
        ((eq (car-safe form) 'cl-eval-when)
@@ -2481,12 +2481,12 @@ values.  For compatibility, (cl-values A B C) is a 
synonym for (list A B C).
                     '(nil byte-compile-inline-expand))
               (error "%s already has a byte-optimizer, can't make it inline"
                      (car spec)))
-          (put (car spec) 'byte-optimizer 'byte-compile-inline-expand)))
+          (put (car spec) 'byte-optimizer #'byte-compile-inline-expand)))
 
        ((eq (car-safe spec) 'notinline)
         (while (setq spec (cdr spec))
           (if (eq (get (car spec) 'byte-optimizer)
-                  'byte-compile-inline-expand)
+                  #'byte-compile-inline-expand)
               (put (car spec) 'byte-optimizer nil))))
 
        ((eq (car-safe spec) 'optimize)
@@ -3257,7 +3257,6 @@ does not contain SLOT-NAME."
       (signal 'cl-struct-unknown-slot (list struct-type slot-name))))
 
 (defvar byte-compile-function-environment)
-(defvar byte-compile-macro-environment)
 
 (defun cl--macroexp-fboundp (sym)
   "Return non-nil if SYM will be bound when we run the code.
@@ -3265,7 +3264,7 @@ Of course, we really can't know that for sure, so it's 
just a heuristic."
   (or (fboundp sym)
       (and (macroexp-compiling-p)
            (or (cdr (assq sym byte-compile-function-environment))
-               (cdr (assq sym byte-compile-macro-environment))))))
+               (cdr (assq sym macroexpand-all-environment))))))
 
 (pcase-dolist (`(,type . ,pred)
                ;; Mostly kept in alphabetical order.
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index a5c877e..155b6a9 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -277,14 +277,7 @@ It should only be stopped when ran from inside 
ert--run-test-internal."
   (let ((form
          ;; catch macroexpansion errors
          (condition-case err
-             (macroexpand-all form
-                              (append (bound-and-true-p
-                                       byte-compile-macro-environment)
-                                      (cond
-                                       ((boundp 'macroexpand-all-environment)
-                                        macroexpand-all-environment)
-                                       ((boundp 'cl-macro-environment)
-                                        cl-macro-environment))))
+             (macroexpand-all form macroexpand-all-environment)
            (error `(signal ',(car err) ',(cdr err))))))
     (cond
      ((or (atom form) (ert--special-operator-p (car form)))
@@ -1550,7 +1543,7 @@ Ran \\([0-9]+\\) tests, \\([0-9]+\\) results as expected\
       (message "------------------")
       (setq tests (sort tests (lambda (x y) (> (car x) (car y)))))
       (when (< high (length tests)) (setcdr (nthcdr (1- high) tests) nil))
-      (message "%s" (mapconcat 'cdr tests "\n")))
+      (message "%s" (mapconcat #'cdr tests "\n")))
     ;; More details on hydra, where the logs are harder to get to.
     (when (and (getenv "EMACS_HYDRA_CI")
                (not (zerop (+ nunexpected nskipped))))
@@ -2077,7 +2070,7 @@ and how to display message."
     (ert-run-tests selector listener t)))
 
 ;;;###autoload
-(defalias 'ert 'ert-run-tests-interactively)
+(defalias 'ert #'ert-run-tests-interactively)
 
 
 ;;; Simple view mode for auxiliary information like stack traces or