From a0f60293d97cda858c033db4ae074e5e5560aab2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 1 Mar 2021 12:18:49 -0500 Subject: [PATCH] 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 84199c16127..eabba27d229 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 007466bbb00..91146c4d0ec 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 a5c877e53ad..155b6a9d4e6 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 -- 2.39.2