1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00

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.
This commit is contained in:
Stefan Monnier 2021-03-01 12:18:49 -05:00
parent 6ad9b8d677
commit a0f60293d9
3 changed files with 18 additions and 27 deletions

View file

@ -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.

View file

@ -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.

View file

@ -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