[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master f262a6af36: (macroexp-warn-and-return): Fix bug#53618
|
From: |
Stefan Monnier |
|
Subject: |
master f262a6af36: (macroexp-warn-and-return): Fix bug#53618 |
|
Date: |
Sat, 19 Feb 2022 14:20:11 -0500 (EST) |
branch: master
commit f262a6af3694b41828ffb8e62a800f8a3ed4e4aa
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
(macroexp-warn-and-return): Fix bug#53618
* lisp/emacs-lisp/macroexp.el (macroexp-warn-and-return):
Reorder arguments to preserve compatibility with that of Emacs-28.
(macroexp--unfold-lambda, macroexp--expand-all):
* lisp/emacs-lisp/pcase.el (pcase-compile-patterns, pcase--u1):
* lisp/emacs-lisp/gv.el (gv-ref):
* lisp/emacs-lisp/eieio.el (defclass):
* lisp/emacs-lisp/eieio-core.el (eieio-oref, eieio-oref-default)
(eieio-oset-default):
* lisp/emacs-lisp/easy-mmode.el (define-minor-mode):
* lisp/emacs-lisp/cl-macs.el (cl-symbol-macrolet, cl-defstruct):
* lisp/emacs-lisp/cl-generic.el (cl-defmethod):
* lisp/emacs-lisp/byte-run.el (defmacro, defun):
* lisp/emacs-lisp/bindat.el (bindat--type): Adjust accordingly.
---
lisp/emacs-lisp/bindat.el | 1 -
lisp/emacs-lisp/byte-run.el | 6 ++----
lisp/emacs-lisp/cl-generic.el | 5 ++---
lisp/emacs-lisp/cl-macs.el | 9 +++------
lisp/emacs-lisp/easy-mmode.el | 1 -
lisp/emacs-lisp/eieio-core.el | 15 +++++----------
lisp/emacs-lisp/eieio.el | 6 +++---
lisp/emacs-lisp/gv.el | 7 ++-----
lisp/emacs-lisp/macroexp.el | 22 +++++++++-------------
lisp/emacs-lisp/pcase.el | 6 ++----
10 files changed, 28 insertions(+), 50 deletions(-)
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 04c5b9f080..c6d64975ec 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -804,7 +804,6 @@ is the name of a variable that will hold the value we need
to pack.")
(if (or (eq label '_) (not (assq label labels)))
code
(macroexp-warn-and-return
- code
(format "Duplicate label: %S" label)
code))))
(`(,_ ,val)
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 5c59d0ae94..c542c55016 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -311,11 +311,10 @@ The return value is undefined.
(let ((f (cdr (assq (car x) macro-declarations-alist))))
(if f (apply (car f) name arglist (cdr x))
(macroexp-warn-and-return
- (car x)
(format-message
"Unknown macro property %S in %S"
(car x) name)
- nil))))
+ nil nil nil (car x)))))
decls)))
;; Refresh font-lock if this is a new macro, or it is an
;; existing macro whose 'no-font-lock-keyword declaration
@@ -385,10 +384,9 @@ The return value is undefined.
nil)
(t
(macroexp-warn-and-return
- (car x)
(format-message "Unknown defun property `%S' in %S"
(car x) name)
- nil)))))
+ nil nil nil (car x))))))
decls))
(def (list 'defalias
(list 'quote name)
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 5e0e0834ff..b44dda6f9d 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -499,7 +499,7 @@ The set of acceptable TYPEs (also called \"specializers\")
is defined
lambda-doc ; documentation string
def-body))) ; part to be debugged
(let ((qualifiers nil)
- (org-name name))
+ (orig-name name))
(while (cl-generic--method-qualifier-p args)
(push args qualifiers)
(setq args (pop body)))
@@ -514,9 +514,8 @@ The set of acceptable TYPEs (also called \"specializers\")
is defined
(byte-compile-warning-enabled-p 'obsolete name))
(let* ((obsolete (get name 'byte-obsolete-info)))
(macroexp-warn-and-return
- org-name
(macroexp--obsolete-warning name obsolete "generic function")
- nil)))
+ nil nil nil orig-name)))
;; You could argue that `defmethod' modifies rather than defines the
;; function, so warnings like "not known to be defined" are fair game.
;; But in practice, it's common to use `cl-defmethod'
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 470168177c..5085217250 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2431,10 +2431,9 @@ by EXPANSION, and (setq NAME ...) will act like (setf
EXPANSION ...).
(if malformed-bindings
(let ((rev-malformed-bindings (nreverse malformed-bindings)))
(macroexp-warn-and-return
- rev-malformed-bindings
(format-message "Malformed `cl-symbol-macrolet' binding(s):
%S"
rev-malformed-bindings)
- expansion))
+ expansion nil nil rev-malformed-bindings))
expansion)))
(unless advised
(advice-remove 'macroexpand #'cl--sm-macroexpand)))))
@@ -3118,20 +3117,18 @@ To see the documentation for a defined struct type, use
(when (cl-oddp (length desc))
(push
(macroexp-warn-and-return
- (car (last desc))
(format "Missing value for option `%S' of slot `%s' in
struct %s!"
(car (last desc)) slot name)
- 'nil)
+ nil nil nil (car (last desc)))
forms)
(when (and (keywordp (car defaults))
(not (keywordp (car desc))))
(let ((kw (car defaults)))
(push
(macroexp-warn-and-return
- kw
(format " I'll take `%s' to be an option rather than a
default value."
kw)
- 'nil)
+ nil nil nil kw)
forms)
(push kw desc)
(setcar defaults nil))))
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 7bcb2f2936..688c76e0c5 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -230,7 +230,6 @@ INIT-VALUE LIGHTER KEYMAP.
(warnwrap (if (or (null body) (keywordp (car body))) #'identity
(lambda (exp)
(macroexp-warn-and-return
- exp
"Use keywords rather than deprecated positional
arguments to `define-minor-mode'"
exp))))
keyw keymap-sym tmp)
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 45ded15899..19aa20fa08 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -748,9 +748,8 @@ Argument FN is the function calling this verifier."
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-slot-names))))
(macroexp-warn-and-return
- name
(format-message "Unknown slot `%S'" name)
- exp nil 'compile-only))
+ exp nil 'compile-only name))
(_ exp))))
(gv-setter eieio-oset))
(cl-check-type slot symbol)
@@ -785,15 +784,13 @@ Fills in CLASS's SLOT with its default value."
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-slot-names))))
(macroexp-warn-and-return
- name
(format-message "Unknown slot `%S'" name)
- exp nil 'compile-only))
+ exp nil 'compile-only name))
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-class-slot-names))))
(macroexp-warn-and-return
- name
(format-message "Slot `%S' is not class-allocated" name)
- exp nil 'compile-only))
+ exp nil 'compile-only name))
(_ exp)))))
(cl-check-type class (or eieio-object class))
(cl-check-type slot symbol)
@@ -849,15 +846,13 @@ Fills in the default value in CLASS' in SLOT with VALUE."
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-slot-names))))
(macroexp-warn-and-return
- name
(format-message "Unknown slot `%S'" name)
- exp nil 'compile-only))
+ exp nil 'compile-only name))
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-class-slot-names))))
(macroexp-warn-and-return
- name
(format-message "Slot `%S' is not class-allocated" name)
- exp nil 'compile-only))
+ exp nil 'compile-only name))
(_ exp)))))
(setq class (eieio--class-object class))
(cl-check-type class eieio--class)
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 6f97c25ca9..1315ca0c62 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -246,7 +246,7 @@ This method is obsolete."
`(progn
,@(mapcar (lambda (w)
(macroexp-warn-and-return
- (car w) (cdr w) `(progn ',(cdr w)) nil 'compile-only))
+ (cdr w) `(progn ',(cdr w)) nil 'compile-only (car w)))
warnings)
;; This test must be created right away so we can have self-
;; referencing classes. ei, a class whose slot can contain only
@@ -296,13 +296,13 @@ This method is obsolete."
(if (not (stringp (car slots)))
whole
(macroexp-warn-and-return
- (car slots)
(format "Obsolete name arg %S to constructor %S"
(car slots) (car whole))
;; Keep the name arg, for backward compatibility,
;; but hide it so we don't trigger indefinitely.
`(,(car whole) (identity ,(car slots))
- ,@(cdr slots)))))))
+ ,@(cdr slots))
+ nil nil (car slots))))))
(apply #'make-instance ',name slots))))))
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index 91538d1f06..7cfa1f2dad 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -581,9 +581,7 @@ This is like the `&' operator of the C language.
Note: this only works reliably with lexical binding mode, except for very
simple PLACEs such as (symbol-function \\='foo) which will also work in dynamic
binding mode."
- (let ((org-place place) ; It's too difficult to determine by inspection
whether
- ; the functions modify place.
- (code
+ (let ((code
(gv-letplace (getter setter) place
`(cons (lambda () ,getter)
(lambda (gv--val) ,(funcall setter 'gv--val))))))
@@ -595,9 +593,8 @@ binding mode."
(eq (car-safe code) 'cons))
code
(macroexp-warn-and-return
- org-place
"Use of gv-ref probably requires lexical-binding"
- code))))
+ code nil nil place))))
(defsubst gv-deref (ref)
"Dereference REF, returning the referenced value.
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 256092599b..e91b302af1 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -160,14 +160,14 @@ Other uses risk returning non-nil value that point to the
wrong file."
(define-obsolete-function-alias 'macroexp--warn-and-return
#'macroexp-warn-and-return "28.1")
-(defun macroexp-warn-and-return (arg msg form &optional category compile-only)
+(defun macroexp-warn-and-return (msg form &optional category compile-only arg)
"Return code equivalent to FORM labeled with warning MSG.
-ARG is a symbol (or a form) giving the source code position of FORM
-for the message. It should normally be a symbol with position.
CATEGORY is the category of the warning, like the categories that
can appear in `byte-compile-warnings'.
COMPILE-ONLY non-nil means no warning should be emitted if the code
-is executed without being compiled first."
+is executed without being compiled first.
+ARG is a symbol (or a form) giving the source code position for the message.
+It should normally be a symbol with position and it defaults to FORM."
(cond
((null msg) form)
((macroexp-compiling-p)
@@ -177,7 +177,7 @@ is executed without being compiled first."
;; macroexpand-all gets right back to macroexpanding `form'.
form
(puthash form form macroexp--warned)
- (macroexp--warn-wrap arg msg form category)))
+ (macroexp--warn-wrap (or arg form) msg form category)))
(t
(unless compile-only
(message "%sWarning: %s"
@@ -233,12 +233,11 @@ is executed without being compiled first."
(let* ((fun (car form))
(obsolete (get fun 'byte-obsolete-info)))
(macroexp-warn-and-return
- fun
(macroexp--obsolete-warning
fun obsolete
(if (symbolp (symbol-function fun))
"alias" "macro"))
- new-form (list 'obsolete fun)))
+ new-form (list 'obsolete fun) nil fun))
new-form)))
(defun macroexp--unfold-lambda (form &optional name)
@@ -289,12 +288,11 @@ is executed without being compiled first."
(setq arglist (cdr arglist)))
(if values
(macroexp-warn-and-return
- arglist
(format (if (eq values 'too-few)
"attempt to open-code `%s' with too few arguments"
"attempt to open-code `%s' with too many arguments")
name)
- form)
+ form nil nil arglist)
;; The following leads to infinite recursion when loading a
;; file containing `(defsubst f () (f))', and then trying to
@@ -365,9 +363,8 @@ Assumes the caller has bound `macroexpand-all-environment'."
(if (null body)
(macroexp-unprogn
(macroexp-warn-and-return
- fun
(format "Empty %s body" fun)
- nil nil 'compile-only))
+ nil nil 'compile-only fun))
(macroexp--all-forms body))
(cdr form))
form)))
@@ -405,11 +402,10 @@ Assumes the caller has bound
`macroexpand-all-environment'."
(eq 'lambda (car-safe (cadr arg))))
(setcar (nthcdr funarg form)
(macroexp-warn-and-return
- (cadr arg)
(format "%S quoted with ' rather than with #'"
(let ((f (cadr arg)))
(if (symbolp f) f `(lambda ,(nth 1 f)
...))))
- arg)))))
+ arg nil nil (cadr arg))))))
;; Macro expand compiler macros. This cannot be delayed to
;; byte-optimize-form because the output of the compiler-macro can
;; use macros.
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index c3dbfe2947..0330a2a0ab 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -433,10 +433,9 @@ how many time this CODEGEN is called."
(memq (car case) pcase--dontwarn-upats))
(setq main
(macroexp-warn-and-return
- (car case)
(format "pcase pattern %S shadowed by previous pcase pattern"
(car case))
- main))))
+ main nil nil (car case)))))
main)))
(defun pcase--expand (exp cases)
@@ -941,9 +940,8 @@ Otherwise, it defers to REST which is a list of branches of
the form
(let ((code (pcase--u1 matches code vars rest)))
(if (eq upat '_) code
(macroexp-warn-and-return
- upat
"Pattern t is deprecated. Use `_' instead"
- code))))
+ code nil nil upat))))
((eq upat 'pcase--dontcare) :pcase--dontcare)
((memq (car-safe upat) '(guard pred))
(if (eq (car upat) 'pred) (pcase--mark-used sym))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master f262a6af36: (macroexp-warn-and-return): Fix bug#53618,
Stefan Monnier <=