Commit 52187012 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* lisp/emacs-lisp/macroexp.el (macroexp-warn-and-return): Add arg `category`

Use it to obey `byte-compile-warnings`.

(macroexp--warn-wrap): Add arg `category`.
(macroexp-macroexpand, macroexp--expand-all): Use it.

* lisp/emacs-lisp/cconv.el (cconv--convert-funcbody, cconv-convert):
Mark the warnings as `lexical`.

* lisp/emacs-lisp/eieio-core.el (eieio-oref, eieio-oref-default)
(eieio-oset-default):
* lisp/emacs-lisp/eieio.el (defclass): Adjust to new calling convention.
parent da4b3973
......@@ -259,8 +259,7 @@ Returns a form where all lambdas don't have any free variables."
(not (intern-soft var))
(eq ?_ (aref (symbol-name var) 0))
;; As a special exception, ignore "ignore".
(eq var 'ignored)
(not (byte-compile-warning-enabled-p 'unbound var)))
(eq var 'ignored))
(let ((suggestions (help-uni-confusable-suggestions (symbol-name var))))
(format "Unused lexical %s `%S'%s"
varkind var
......@@ -287,7 +286,7 @@ of converted forms."
(let (and (pred stringp) msg)
(cconv--warn-unused-msg arg "argument")))
(if (assq arg env) (push `(,arg . nil) env)) ;FIXME: Is it needed?
(push (lambda (body) (macroexp--warn-wrap msg body)) wrappers))
(push (lambda (body) (macroexp--warn-wrap msg body 'lexical)) wrappers))
(_
(if (assq arg env) (push `(,arg . nil) env)))))
(setq funcbody (mapcar (lambda (form)
......@@ -408,7 +407,7 @@ places where they originally did not directly appear."
`(ignore ,(cconv-convert value env extend)))
(msg (cconv--warn-unused-msg var "variable")))
(if (null msg) newval
(macroexp--warn-wrap msg newval))))
(macroexp--warn-wrap msg newval 'lexical))))
;; Normal default case.
(_
......@@ -507,7 +506,7 @@ places where they originally did not directly appear."
(newprotform (cconv-convert protected-form env extend)))
`(condition-case ,var
,(if msg
(macroexp--warn-wrap msg newprotform)
(macroexp--warn-wrap msg newprotform 'lexical)
newprotform)
,@(mapcar
(lambda (handler)
......@@ -599,14 +598,16 @@ FORM is the parent form that binds this var."
(`((,(and var (guard (eq ?_ (aref (symbol-name var) 0)))) . ,_)
,_ ,_ ,_ ,_)
;; FIXME: Convert this warning to use `macroexp--warn-wrap'
;; so as to give better position information.
;; so as to give better position information and obey
;; `byte-compile-warnings'.
(byte-compile-warn
"%s `%S' not left unused" varkind var))
((and (let (or 'let* 'let) (car form))
`((,var) ;; (or `(,var nil) : Too many false positives: bug#47080
t nil ,_ ,_))
;; FIXME: Convert this warning to use `macroexp--warn-wrap'
;; so as to give better position information.
;; so as to give better position information and obey
;; `byte-compile-warnings'.
(unless (not (intern-soft var))
(byte-compile-warn "Variable `%S' left uninitialized" var))))
(pcase vardata
......
......@@ -742,7 +742,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
(format-message "Unknown slot `%S'" name) exp 'compile-only))
(format-message "Unknown slot `%S'" name)
exp nil 'compile-only))
(_ exp))))
(gv-setter eieio-oset))
(cl-check-type slot symbol)
......@@ -777,12 +778,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
(format-message "Unknown slot `%S'" name) exp 'compile-only))
(format-message "Unknown slot `%S'" name)
exp nil 'compile-only))
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-class-slot-names))))
(macroexp-warn-and-return
(format-message "Slot `%S' is not class-allocated" name)
exp 'compile-only))
exp nil 'compile-only))
(_ exp)))))
(cl-check-type class (or eieio-object class))
(cl-check-type slot symbol)
......@@ -838,12 +840,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
(format-message "Unknown slot `%S'" name) exp 'compile-only))
(format-message "Unknown slot `%S'" name)
exp nil 'compile-only))
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-class-slot-names))))
(macroexp-warn-and-return
(format-message "Slot `%S' is not class-allocated" name)
exp 'compile-only))
exp nil 'compile-only))
(_ exp)))))
(setq class (eieio--class-object class))
(cl-check-type class eieio--class)
......
......@@ -241,7 +241,8 @@ This method is obsolete."
))
`(progn
,@(mapcar (lambda (w) (macroexp-warn-and-return w `(progn ',w) 'compile-only))
,@(mapcar (lambda (w)
(macroexp-warn-and-return w `(progn ',w) nil 'compile-only))
warnings)
;; This test must be created right away so we can have self-
;; referencing classes. ei, a class whose slot can contain only
......@@ -742,7 +743,7 @@ Called from the constructor routine."
(cl-defmethod initialize-instance ((this eieio-default-superclass)
&optional args)
"Construct the new object THIS based on SLOTS.
"Construct the new object THIS based on ARGS.
ARGS is a property list where odd numbered elements are tags, and
even numbered elements are the values to store in the tagged slot.
If you overload the `initialize-instance', there you will need to
......
......@@ -135,15 +135,22 @@ Other uses risk returning non-nil value that point to the wrong file."
(defvar macroexp--warned (make-hash-table :test #'equal :weakness 'key))
(defun macroexp--warn-wrap (msg form)
(let ((when-compiled (lambda () (byte-compile-warn "%s" msg))))
(defun macroexp--warn-wrap (msg form category)
(let ((when-compiled (lambda ()
(when (byte-compile-warning-enabled-p category)
(byte-compile-warn "%s" msg)))))
`(progn
(macroexp--funcall-if-compiled ',when-compiled)
,form)))
(define-obsolete-function-alias 'macroexp--warn-and-return
#'macroexp-warn-and-return "28.1")
(defun macroexp-warn-and-return (msg form &optional compile-only)
(defun macroexp-warn-and-return (msg form &optional category compile-only)
"Return code equivalent to FORM by labeled with warning MSG.
CATEGORY is the category of the warning, like the categories that
can appear in `byte-compile-warnings'.
COMPILE-ONLY if non-nil indicates that no warning should be emitted if
the code is executed without being compiled first."
(cond
((null msg) form)
((macroexp-compiling-p)
......@@ -153,7 +160,7 @@ Other uses risk returning non-nil value that point to the wrong file."
;; macroexpand-all gets right back to macroexpanding `form'.
form
(puthash form form macroexp--warned)
(macroexp--warn-wrap msg form)))
(macroexp--warn-wrap msg form category)))
(t
(unless compile-only
(message "%sWarning: %s"
......@@ -205,9 +212,7 @@ Other uses risk returning non-nil value that point to the wrong file."
(if (and (not (eq form new-form)) ;It was a macro call.
(car-safe form)
(symbolp (car form))
(get (car form) 'byte-obsolete-info)
(or (not (fboundp 'byte-compile-warning-enabled-p))
(byte-compile-warning-enabled-p 'obsolete (car form))))
(get (car form) 'byte-obsolete-info))
(let* ((fun (car form))
(obsolete (get fun 'byte-obsolete-info)))
(macroexp-warn-and-return
......@@ -215,7 +220,7 @@ Other uses risk returning non-nil value that point to the wrong file."
fun obsolete
(if (symbolp (symbol-function fun))
"alias" "macro"))
new-form))
new-form 'obsolete))
new-form)))
(defun macroexp--unfold-lambda (form &optional name)
......@@ -325,10 +330,8 @@ Assumes the caller has bound `macroexpand-all-environment'."
(if (null body)
(macroexp-unprogn
(macroexp-warn-and-return
(and (or (not (fboundp 'byte-compile-warning-enabled-p))
(byte-compile-warning-enabled-p t))
(format "Empty %s body" fun))
nil t))
(format "Empty %s body" fun)
nil nil 'compile-only))
(macroexp--all-forms body))
(cdr form))
form))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment