* lisp/emacs-lisp/bytecomp.el: Fix bug#14860.

* lisp/emacs-lisp/bytecomp.el (byte-compile--function-signature): New fun.
Dig into advice wrappers to find the "real" signature.
(byte-compile-callargs-warn, byte-compile-arglist-warn): Use it.
(byte-compile-arglist-signature): Don't bother with "new-style" arglists,
since bytecode functions are now handled in byte-compile--function-signature.

* lisp/files.el (create-file-buffer, insert-directory):
Remove workaround introduced for (bug#14860).

* lisp/help-fns.el (help-fns--analyse-function): `nadvice` is preloaded.

* lisp/help.el (help-function-arglist):
Dig into advice wrappers to find the "real" signature.
This commit is contained in:
Stefan Monnier 2017-07-14 11:27:21 -04:00
parent 583995c62d
commit 6e2d6d54e1
4 changed files with 18 additions and 38 deletions

View file

@ -1263,12 +1263,6 @@ when printing the error message."
(defun byte-compile-arglist-signature (arglist)
(cond
;; New style byte-code arglist.
((integerp arglist)
(cons (logand arglist 127) ;Mandatory.
(if (zerop (logand arglist 128)) ;No &rest.
(lsh arglist -8)))) ;Nonrest.
;; Old style byte-code, or interpreted function.
((listp arglist)
(let ((args 0)
opts
@ -1289,6 +1283,19 @@ when printing the error message."
;; Unknown arglist.
(t '(0))))
(defun byte-compile--function-signature (f)
;; Similar to help-function-arglist, except that it returns the info
;; in a different format.
(and (eq 'macro (car-safe f)) (setq f (cdr f)))
;; Advice wrappers have "catch all" args, so fetch the actual underlying
;; function to find the real arguments.
(while (advice--p f) (setq f (advice--cdr f)))
(if (eq (car-safe f) 'declared)
(byte-compile-arglist-signature (nth 1 f))
(condition-case nil
(let ((sig (func-arity f)))
(if (numberp (cdr sig)) sig (list (car sig))))
(error '(0)))))
(defun byte-compile-arglist-signatures-congruent-p (old new)
(not (or
@ -1330,19 +1337,7 @@ when printing the error message."
(defun byte-compile-callargs-warn (form)
(let* ((def (or (byte-compile-fdefinition (car form) nil)
(byte-compile-fdefinition (car form) t)))
(sig (if (and def (not (eq def t)))
(progn
(and (eq (car-safe def) 'macro)
(eq (car-safe (cdr-safe def)) 'lambda)
(setq def (cdr def)))
(byte-compile-arglist-signature
(if (memq (car-safe def) '(declared lambda))
(nth 1 def)
(if (byte-code-function-p def)
(aref def 0)
'(&rest def)))))
(if (subrp (symbol-function (car form)))
(subr-arity (symbol-function (car form))))))
(sig (byte-compile--function-signature def))
(ncall (length (cdr form))))
;; Check many or unevalled from subr-arity.
(if (and (cdr-safe sig)
@ -1461,15 +1456,7 @@ extra args."
(and initial (symbolp initial)
(setq old (byte-compile-fdefinition initial nil)))
(when (and old (not (eq old t)))
(and (eq 'macro (car-safe old))
(eq 'lambda (car-safe (cdr-safe old)))
(setq old (cdr old)))
(let ((sig1 (byte-compile-arglist-signature
(pcase old
(`(lambda ,args . ,_) args)
(`(closure ,_ ,args . ,_) args)
((pred byte-code-function-p) (aref old 0))
(_ '(&rest def)))))
(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)

View file

@ -1821,10 +1821,6 @@ otherwise a string <2> or <3> or ... is appended to get an unused name.
Emacs treats buffers whose names begin with a space as internal buffers.
To avoid confusion when visiting a file whose name begins with a space,
this function prepends a \"|\" to the final result if necessary."
;; We need the following 'declare' form to shut up the byte
;; compiler, which displays a bogus warning for advised functions,
;; see bug#14860.
(declare (advertised-calling-convention (filename) "18.59"))
(let ((lastname (file-name-nondirectory filename)))
(if (string= lastname "")
(setq lastname filename))
@ -6594,11 +6590,6 @@ When SWITCHES contains the long `--dired' option, this function
treats it specially, for the sake of dired. However, the
normally equivalent short `-D' option is just passed on to
`insert-directory-program', as any other option."
;; We need the following 'declare' form to shut up the byte
;; compiler, which displays a bogus warning for advised functions,
;; see bug#14860.
(declare (advertised-calling-convention
(file switches &optional wildcard full-directory-p) "19.34"))
;; We need the directory in order to find the right handler.
(let ((handler (find-file-name-handler (expand-file-name file)
'insert-directory)))

View file

@ -564,7 +564,6 @@ FILE is the file where FUNCTION was probably defined."
"Return information about FUNCTION.
Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
(let* ((advised (and (symbolp function)
(featurep 'nadvice)
(advice--p (advice--symbol-function function))))
;; If the function is advised, use the symbol that has the
;; real definition, if that symbol is already set up.

View file

@ -1384,6 +1384,9 @@ If PRESERVE-NAMES is non-nil, return a formal arglist that uses
the same names as used in the original source code, when possible."
;; Handle symbols aliased to other symbols.
(if (and (symbolp def) (fboundp def)) (setq def (indirect-function def)))
;; Advice wrappers have "catch all" args, so fetch the actual underlying
;; function to find the real arguments.
(while (advice--p def) (setq def (advice--cdr def)))
;; If definition is a macro, find the function inside it.
(if (eq (car-safe def) 'macro) (setq def (cdr def)))
(cond