mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-06 06:20:55 -08:00
Remove the remnants of old position mechanism from scratch/correct-warning-pos
Also correct one or two positions in macroexp-warn-and-return invocations. * lisp/emacs-lisp/bytecomp.el (byte-compile-read-position) (byte-compile-last-position, byte-compile-set-symbol-position): Remove. (byte-compile-warning-prefix, byte-compile-function-warn) (byte-compile-emit-callargs-warn, byte-compile-arglist-warn) (byte-compile-warn-about-unresolved-functions, compile-defun) (byte-compile-from-buffer, byte-compile-from-buffer) (byte-compile-file-form-defmumble, byte-compile-check-lambda-list) (byte-compile-lambda, byte-compile-form, byte-compile-normal-call) (byte-compile-check-variable, byte-compile-push-constant) (byte-compile-subr-wrong-args, byte-compile-negation-optimizer) (byte-compile-condition-case, byte-compile-defvar, byte-compile-autoload) (byte-compile-lambda-form): Remove the remnants of the old warning position mechanism. (byte-compile-function-warn): Replace byte-compile-last-position by a symbol-with-pos-pos call. (compile-defun): Use local variable start-read-position to fulfil purpose of old byte-compile-read-position. Push the just read FORM onto byte-compile-form-stack. * lisp/emacs-lisp/eieio.el (defclass): New mechanism to get the correct source warning position to macroexp-warn-and-return. * lisp/emacs-lisp/macroexp (macroexp--unfold-lambda): Correct the position argument given to macroexp-warn-and-return.
This commit is contained in:
Alan Mackenzie
parent
d87a34597c
commit
3023e7ca3d
3 changed files with 34 additions and 123 deletions
|
|
@ -1149,11 +1149,6 @@ message buffer `default-directory'."
|
|||
(t
|
||||
(insert (format "%s\n" string)))))))
|
||||
|
||||
(defvar byte-compile-read-position nil
|
||||
"Character position we began the last `read' from.")
|
||||
(defvar byte-compile-last-position nil
|
||||
"Last known character position in the input.")
|
||||
|
||||
;; copied from gnus-util.el
|
||||
(defsubst byte-compile-delete-first (elt list)
|
||||
(if (eq (car list) elt)
|
||||
|
|
@ -1166,43 +1161,6 @@ message buffer `default-directory'."
|
|||
(setcdr list (cddr list)))
|
||||
total)))
|
||||
|
||||
;; The purpose of `byte-compile-set-symbol-position' is to attempt to
|
||||
;; set `byte-compile-last-position' to the "current position" in the
|
||||
;; raw source code. This is used for warning and error messages.
|
||||
;;
|
||||
;; The function should be called for most occurrences of symbols in
|
||||
;; the forms being compiled, strictly in the order they occur in the
|
||||
;; source code. It should never be called twice for any single
|
||||
;; occurrence, and should not be called for symbols generated by the
|
||||
;; byte compiler itself.
|
||||
;;
|
||||
;; The function works by scanning the elements in the alist
|
||||
;; `read-symbol-positions-list' for the next match for the symbol
|
||||
;; after the current value of `byte-compile-last-position', setting
|
||||
;; that variable to the match's character position, then deleting the
|
||||
;; matching element from the list. Thus the new value for
|
||||
;; `byte-compile-last-position' is later than the old value unless,
|
||||
;; perhaps, ALLOW-PREVIOUS is non-nil.
|
||||
;;
|
||||
;; So your're probably asking yourself: Isn't this function a gross
|
||||
;; hack? And the answer, of course, would be yes.
|
||||
(defun byte-compile-set-symbol-position (sym &optional allow-previous)
|
||||
(when byte-compile-read-position
|
||||
(let ((last byte-compile-last-position)
|
||||
entry)
|
||||
(while (progn
|
||||
(setq entry (assq sym read-symbol-positions-list))
|
||||
(when entry
|
||||
(setq byte-compile-last-position
|
||||
(+ byte-compile-read-position (cdr entry))
|
||||
read-symbol-positions-list
|
||||
(byte-compile-delete-first
|
||||
entry read-symbol-positions-list)))
|
||||
(and entry
|
||||
(or (and allow-previous
|
||||
(not (= last byte-compile-last-position)))
|
||||
(> last byte-compile-last-position))))))))
|
||||
|
||||
(defvar byte-compile-last-warned-form nil)
|
||||
(defvar byte-compile-last-logged-file nil)
|
||||
(defvar byte-compile-root-dir nil
|
||||
|
|
@ -1269,34 +1227,14 @@ Return nil if such is not found."
|
|||
(t "")))
|
||||
(offset (byte-compile--warning-source-offset))
|
||||
(pos (if (and byte-compile-current-file
|
||||
(integerp byte-compile-read-position)
|
||||
(or offset (not symbols-with-pos-enabled)))
|
||||
(with-current-buffer byte-compile-current-buffer
|
||||
;; (format "%d:%d:"
|
||||
;; (save-excursion
|
||||
;; (goto-char (if symbols-with-pos-enabled
|
||||
;; (+ byte-compile-read-position offset)
|
||||
;; byte-compile-last-position)
|
||||
;; )
|
||||
;; (1+ (count-lines (point-min) (point-at-bol))))
|
||||
;; (save-excursion
|
||||
;; (goto-char (if symbols-with-pos-enabled
|
||||
;; (+ byte-compile-read-position offset)
|
||||
;; byte-compile-last-position)
|
||||
;; )
|
||||
;; (1+ (current-column))))
|
||||
;;;; EXPERIMENTAL STOUGH, 2018-11-22
|
||||
(let (old-l old-c new-l new-c)
|
||||
(let (new-l new-c)
|
||||
(save-excursion
|
||||
(goto-char byte-compile-last-position)
|
||||
(setq old-l (1+ (count-lines (point-min) (point-at-bol)))
|
||||
old-c (1+ (current-column)))
|
||||
(goto-char offset)
|
||||
(setq new-l (1+ (count-lines (point-min) (point-at-bol)))
|
||||
new-c (1+ (current-column)))
|
||||
(format "%d:%d:%d:%d:" old-l old-c new-l new-c)))
|
||||
;;;; END OF EXPERIMENTAL STOUGH
|
||||
)
|
||||
(format "%d:%d:" new-l new-c))))
|
||||
""))
|
||||
(form (if (eq byte-compile-current-form :end) "end of data"
|
||||
(or byte-compile-current-form "toplevel form"))))
|
||||
|
|
@ -1379,7 +1317,7 @@ nil.")
|
|||
STRING, FILL and LEVEL are as described in
|
||||
`byte-compile-log-warning-function', which see."
|
||||
(funcall byte-compile-log-warning-function
|
||||
string byte-compile-last-position
|
||||
string nil
|
||||
fill
|
||||
level))
|
||||
|
||||
|
|
@ -1525,7 +1463,6 @@ when printing the error message."
|
|||
(t (format "%d-%d" (car signature) (cdr signature)))))
|
||||
|
||||
(defun byte-compile-function-warn (f nargs def)
|
||||
(byte-compile-set-symbol-position f)
|
||||
(when (and (get f 'byte-obsolete-info)
|
||||
(byte-compile-warning-enabled-p 'obsolete f))
|
||||
(byte-compile-warn-obsolete f))
|
||||
|
|
@ -1542,11 +1479,14 @@ when printing the error message."
|
|||
(if cons
|
||||
(or (memq nargs (cddr cons))
|
||||
(push nargs (cddr cons)))
|
||||
(push (list f byte-compile-last-position nargs)
|
||||
(push (list f
|
||||
(if (symbol-with-pos-p f)
|
||||
(symbol-with-pos-pos f)
|
||||
1) ; Should never happen.
|
||||
nargs)
|
||||
byte-compile-unresolved-functions)))))
|
||||
|
||||
(defun byte-compile-emit-callargs-warn (name actual-args min-args max-args)
|
||||
(byte-compile-set-symbol-position name)
|
||||
(byte-compile-warn-x
|
||||
name
|
||||
"%s called with %d argument%s, but %s %s"
|
||||
|
|
@ -1672,7 +1612,6 @@ extra args."
|
|||
max (car (nreverse nums)))
|
||||
(when (or (< min (car sig))
|
||||
(and (cdr sig) (> max (cdr sig))))
|
||||
(byte-compile-set-symbol-position name)
|
||||
(byte-compile-warn-x
|
||||
name
|
||||
"%s being defined to take %s%s, but was previously called with %s"
|
||||
|
|
@ -1692,7 +1631,6 @@ extra args."
|
|||
(let ((sig1 (byte-compile--function-signature old))
|
||||
(sig2 (byte-compile-arglist-signature arglist)))
|
||||
(unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
|
||||
(byte-compile-set-symbol-position name)
|
||||
(byte-compile-warn-x
|
||||
name
|
||||
"%s %s used to take %s %s, now takes %s"
|
||||
|
|
@ -1785,7 +1723,7 @@ It is too wide if it has any lines longer than the largest of
|
|||
(byte-compile--wide-docstring-p docs col))
|
||||
(byte-compile-warn-x
|
||||
name
|
||||
"%s%s docstring wider than %s characters"
|
||||
"%s%sdocstring wider than %s characters"
|
||||
kind name col))))
|
||||
form)
|
||||
|
||||
|
|
@ -1800,11 +1738,10 @@ It is too wide if it has any lines longer than the largest of
|
|||
(dolist (urf byte-compile-unresolved-functions)
|
||||
(let ((f (car urf)))
|
||||
(when (not (memq f byte-compile-new-defuns))
|
||||
(let ((byte-compile-last-position (cadr urf)))
|
||||
(byte-compile-warn-x
|
||||
f
|
||||
(if (fboundp f) "the function `%s' might not be defined at runtime." "the function `%s' is not known to be defined.")
|
||||
(car urf))))))))
|
||||
(byte-compile-warn-x
|
||||
f
|
||||
(if (fboundp f) "the function `%s' might not be defined at runtime." "the function `%s' is not known to be defined.")
|
||||
(car urf)))))))
|
||||
nil)
|
||||
|
||||
|
||||
|
|
@ -2266,8 +2203,7 @@ With argument ARG, insert value in current buffer after the form."
|
|||
(let* ((print-symbols-bare t)
|
||||
(byte-compile-current-file (current-buffer))
|
||||
(byte-compile-current-buffer (current-buffer))
|
||||
(byte-compile-read-position (point))
|
||||
(byte-compile-last-position byte-compile-read-position)
|
||||
(start-read-position (point))
|
||||
(byte-compile-last-warned-form 'nothing)
|
||||
(value (eval
|
||||
(let ((read-with-symbol-positions (current-buffer))
|
||||
|
|
@ -2275,9 +2211,11 @@ With argument ARG, insert value in current buffer after the form."
|
|||
(symbols-with-pos-enabled t))
|
||||
(displaying-byte-compile-warnings
|
||||
(byte-compile-sexp
|
||||
(eval-sexp-add-defvars
|
||||
(read-positioning-symbols (current-buffer))
|
||||
byte-compile-read-position))))
|
||||
(let ((form (read-positioning-symbols (current-buffer))))
|
||||
(push form byte-compile-form-stack)
|
||||
(eval-sexp-add-defvars
|
||||
form
|
||||
start-read-position)))))
|
||||
lexical-binding)))
|
||||
(cond (arg
|
||||
(message "Compiling from buffer... done.")
|
||||
|
|
@ -2287,8 +2225,6 @@ With argument ARG, insert value in current buffer after the form."
|
|||
|
||||
(defun byte-compile-from-buffer (inbuffer)
|
||||
(let ((byte-compile-current-buffer inbuffer)
|
||||
(byte-compile-read-position nil)
|
||||
(byte-compile-last-position nil)
|
||||
;; Prevent truncation of flonums and lists as we read and print them
|
||||
(float-output-format nil)
|
||||
(case-fold-search nil)
|
||||
|
|
@ -2357,8 +2293,6 @@ With argument ARG, insert value in current buffer after the form."
|
|||
(= (following-char) ?\;))
|
||||
(forward-line 1))
|
||||
(not (eobp)))
|
||||
(setq byte-compile-read-position (point)
|
||||
byte-compile-last-position byte-compile-read-position)
|
||||
(let* ((lread--unescaped-character-literals nil)
|
||||
(form (read-positioning-symbols inbuffer))
|
||||
(warning (byte-run--unescaped-character-literals-warning)))
|
||||
|
|
@ -2366,9 +2300,6 @@ With argument ARG, insert value in current buffer after the form."
|
|||
(byte-compile-toplevel-file-form form)))
|
||||
;; Compile pending forms at end of file.
|
||||
(byte-compile-flush-pending)
|
||||
;; Make warnings about unresolved functions
|
||||
;; give the end of the file as their position.
|
||||
(setq byte-compile-last-position (point-max))
|
||||
(byte-compile-warn-about-unresolved-functions)))
|
||||
byte-compile--outbuffer)))
|
||||
|
||||
|
|
@ -2786,7 +2717,6 @@ not to take responsibility for the actual compilation of the code."
|
|||
(bare-name (bare-symbol name))
|
||||
(byte-compile-current-form name)) ; For warnings.
|
||||
|
||||
(byte-compile-set-symbol-position name)
|
||||
(push bare-name byte-compile-new-defuns)
|
||||
;; When a function or macro is defined, add it to the call tree so that
|
||||
;; we can tell when functions are not used.
|
||||
|
|
@ -2845,8 +2775,6 @@ not to take responsibility for the actual compilation of the code."
|
|||
(symbolp (car-safe (cdr-safe body)))
|
||||
(car-safe (cdr-safe body))
|
||||
(stringp (car-safe (cdr-safe (cdr-safe body)))))
|
||||
;; FIXME: We've done that already just above, so this looks wrong!
|
||||
;;(byte-compile-set-symbol-position name)
|
||||
(byte-compile-warn-x
|
||||
name "probable `\"' without `\\' in doc string of %s" bare-name))
|
||||
|
||||
|
|
@ -3024,8 +2952,6 @@ If FORM is a lambda or a macro, byte-compile it as a function."
|
|||
(let (vars)
|
||||
(while list
|
||||
(let ((arg (car list)))
|
||||
(when (symbolp arg)
|
||||
(byte-compile-set-symbol-position arg))
|
||||
(cond ((or (not (symbolp arg))
|
||||
(macroexp--const-symbol-p arg t))
|
||||
(error "Invalid lambda variable %s" arg))
|
||||
|
|
@ -3099,16 +3025,11 @@ If FORM is a lambda or a macro, byte-compile it as a function."
|
|||
(defun byte-compile-lambda (fun &optional add-lambda reserved-csts)
|
||||
"Byte-compile a lambda-expression and return a valid function.
|
||||
The value is usually a compiled function but may be the original
|
||||
lambda-expression.
|
||||
When ADD-LAMBDA is non-nil, the symbol `lambda' is added as head
|
||||
of the list FUN and `byte-compile-set-symbol-position' is not called.
|
||||
Use this feature to avoid calling `byte-compile-set-symbol-position'
|
||||
for symbols generated by the byte compiler itself."
|
||||
lambda-expression."
|
||||
(if add-lambda
|
||||
(setq fun (cons 'lambda fun))
|
||||
(unless (eq 'lambda (car-safe fun))
|
||||
(error "Not a lambda list: %S" fun))
|
||||
(byte-compile-set-symbol-position 'lambda))
|
||||
(error "Not a lambda list: %S" fun)))
|
||||
(byte-compile-docstring-length-warn fun)
|
||||
(byte-compile-check-lambda-list (nth 1 fun))
|
||||
(let* ((arglist (nth 1 fun))
|
||||
|
|
@ -3131,7 +3052,6 @@ for symbols generated by the byte compiler itself."
|
|||
(byte-compile--warn-lexical-dynamic var 'lambda))))
|
||||
;; Process the interactive spec.
|
||||
(when int
|
||||
(byte-compile-set-symbol-position 'interactive)
|
||||
;; Skip (interactive) if it is in front (the most usual location).
|
||||
(if (eq int (car body))
|
||||
(setq body (cdr body)))
|
||||
|
|
@ -3416,13 +3336,9 @@ for symbols generated by the byte compiler itself."
|
|||
(cond
|
||||
((not (consp form))
|
||||
(cond ((or (not (symbolp form)) (macroexp--const-symbol-p form))
|
||||
(when (symbolp form)
|
||||
(byte-compile-set-symbol-position form))
|
||||
(byte-compile-constant
|
||||
(if (symbolp form) (bare-symbol form) form)))
|
||||
((and byte-compile--for-effect byte-compile-delete-errors)
|
||||
(when (symbolp form)
|
||||
(byte-compile-set-symbol-position form))
|
||||
(setq byte-compile--for-effect nil))
|
||||
(t
|
||||
(byte-compile-variable-ref (bare-symbol form)))))
|
||||
|
|
@ -3501,7 +3417,6 @@ for symbols generated by the byte compiler itself."
|
|||
(byte-compile-annotate-call-tree form))
|
||||
(when (and byte-compile--for-effect (eq (car form) 'mapcar)
|
||||
(byte-compile-warning-enabled-p 'mapcar 'mapcar))
|
||||
(byte-compile-set-symbol-position 'mapcar)
|
||||
(byte-compile-warn-x
|
||||
(car form)
|
||||
"`mapcar' called for effect; use `mapc' or `dolist' instead"))
|
||||
|
|
@ -3634,8 +3549,6 @@ for symbols generated by the byte compiler itself."
|
|||
|
||||
(defun byte-compile-check-variable (var access-type)
|
||||
"Do various error checks before a use of the variable VAR."
|
||||
(when (symbolp var)
|
||||
(byte-compile-set-symbol-position var))
|
||||
(cond ((or (not (symbolp var)) (macroexp--const-symbol-p var))
|
||||
(when (byte-compile-warning-enabled-p 'constants
|
||||
(and (symbolp var) var))
|
||||
|
|
@ -3739,7 +3652,6 @@ assignment (i.e. `setq')."
|
|||
;; This ignores byte-compile--for-effect.
|
||||
(defun byte-compile-push-constant (const)
|
||||
(when (symbolp const)
|
||||
(byte-compile-set-symbol-position const)
|
||||
(setq const (bare-symbol const)))
|
||||
(byte-compile-out
|
||||
'byte-constant
|
||||
|
|
@ -3895,7 +3807,6 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
|
|||
|
||||
|
||||
(defun byte-compile-subr-wrong-args (form n)
|
||||
(byte-compile-set-symbol-position (car form))
|
||||
(byte-compile-warn-x (car form)
|
||||
"`%s' called with %d arg%s, but requires %s"
|
||||
(car form) (length (cdr form))
|
||||
|
|
@ -4831,7 +4742,6 @@ binding slots have been popped."
|
|||
;; Even when optimization is off, /= is optimized to (not (= ...)).
|
||||
(defun byte-compile-negation-optimizer (form)
|
||||
;; an optimizer for forms where <form1> is less efficient than (not <form2>)
|
||||
(byte-compile-set-symbol-position (car form))
|
||||
(list 'not
|
||||
(cons (or (get (car form) 'byte-compile-negated-op)
|
||||
(error
|
||||
|
|
@ -4881,7 +4791,6 @@ binding slots have been popped."
|
|||
(cons (byte-compile-make-tag) clause))
|
||||
failure-handlers))
|
||||
(endtag (byte-compile-make-tag)))
|
||||
(byte-compile-set-symbol-position 'condition-case)
|
||||
(unless (symbolp var)
|
||||
(byte-compile-warn-x
|
||||
var "`%s' is not a variable-name or nil (in condition-case)" var))
|
||||
|
|
@ -4994,7 +4903,6 @@ binding slots have been popped."
|
|||
(var (nth 1 form))
|
||||
(value (nth 2 form))
|
||||
(string (nth 3 form)))
|
||||
(byte-compile-set-symbol-position fun)
|
||||
(when (or (> (length form) 4)
|
||||
(and (eq fun 'defconst) (null (cddr form))))
|
||||
(let ((ncall (length (cdr form))))
|
||||
|
|
@ -5027,7 +4935,6 @@ binding slots have been popped."
|
|||
`',var)))))
|
||||
|
||||
(defun byte-compile-autoload (form)
|
||||
(byte-compile-set-symbol-position 'autoload)
|
||||
(and (macroexp-const-p (nth 1 form))
|
||||
(macroexp-const-p (nth 5 form))
|
||||
(memq (eval (nth 5 form)) '(t macro)) ; macro-p
|
||||
|
|
@ -5042,7 +4949,6 @@ binding slots have been popped."
|
|||
;; Lambdas in valid places are handled as special cases by various code.
|
||||
;; The ones that remain are errors.
|
||||
(defun byte-compile-lambda-form (_form)
|
||||
(byte-compile-set-symbol-position 'lambda)
|
||||
(error "`lambda' used as function name is invalid"))
|
||||
|
||||
;; Compile normally, but deal with warnings for the function being defined.
|
||||
|
|
|
|||
|
|
@ -181,9 +181,11 @@ and reference them using the function `class-option'."
|
|||
|
||||
;; Is there an initarg, but allocation of class?
|
||||
(when (and initarg (eq alloc :class))
|
||||
(push (format "Meaningless :initarg for class allocated slot '%S'"
|
||||
sname)
|
||||
warnings))
|
||||
(push
|
||||
(cons sname
|
||||
(format "Meaningless :initarg for class allocated slot '%S'"
|
||||
sname))
|
||||
warnings))
|
||||
|
||||
(let ((init (plist-get soptions :initform)))
|
||||
(unless (or (macroexp-const-p init)
|
||||
|
|
@ -194,8 +196,9 @@ and reference them using the function `class-option'."
|
|||
;; heuristic says and if it disagrees with normal evaluation
|
||||
;; then tweak the initform to make it fit and emit
|
||||
;; a warning accordingly.
|
||||
(push (format "Ambiguous initform needs quoting: %S" init)
|
||||
warnings)))
|
||||
(push
|
||||
(cons init (format "Ambiguous initform needs quoting: %S" init))
|
||||
warnings)))
|
||||
|
||||
;; Anyone can have an accessor function. This creates a function
|
||||
;; of the specified name, and also performs a `defsetf' if applicable
|
||||
|
|
@ -242,8 +245,8 @@ This method is obsolete."
|
|||
|
||||
`(progn
|
||||
,@(mapcar (lambda (w)
|
||||
(macroexp-warn-and-return w ; W is probably a poor choice for a position.
|
||||
w `(progn ',w) nil 'compile-only))
|
||||
(macroexp-warn-and-return
|
||||
(car w) (cdr w) `(progn ',(cdr 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
|
||||
|
|
|
|||
|
|
@ -162,6 +162,8 @@ Other uses risk returning non-nil value that point to the wrong file."
|
|||
#'macroexp-warn-and-return "28.1")
|
||||
(defun macroexp-warn-and-return (arg msg form &optional category compile-only)
|
||||
"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
|
||||
|
|
@ -287,7 +289,7 @@ is executed without being compiled first."
|
|||
(setq arglist (cdr arglist)))
|
||||
(if values
|
||||
(macroexp-warn-and-return
|
||||
name
|
||||
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")
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue