aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2017-07-14 11:27:21 -0400
committerStefan Monnier2017-07-14 11:27:21 -0400
commit6e2d6d54e1236216462c13655ea1fe573d9672e7 (patch)
treea5e1af3e57a5d1c3c7bf7828a60f6ab7c6e28f68
parent583995c62dd424775dda33d5134ce04bee2ae685 (diff)
downloademacs-6e2d6d54e1236216462c13655ea1fe573d9672e7.tar.gz
emacs-6e2d6d54e1236216462c13655ea1fe573d9672e7.zip
* 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.
-rw-r--r--lisp/emacs-lisp/bytecomp.el43
-rw-r--r--lisp/files.el9
-rw-r--r--lisp/help-fns.el1
-rw-r--r--lisp/help.el3
4 files changed, 18 insertions, 38 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index e5b9b47b1d0..fdd4276e4e7 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1263,12 +1263,6 @@ when printing the error message."
1263 1263
1264(defun byte-compile-arglist-signature (arglist) 1264(defun byte-compile-arglist-signature (arglist)
1265 (cond 1265 (cond
1266 ;; New style byte-code arglist.
1267 ((integerp arglist)
1268 (cons (logand arglist 127) ;Mandatory.
1269 (if (zerop (logand arglist 128)) ;No &rest.
1270 (lsh arglist -8)))) ;Nonrest.
1271 ;; Old style byte-code, or interpreted function.
1272 ((listp arglist) 1266 ((listp arglist)
1273 (let ((args 0) 1267 (let ((args 0)
1274 opts 1268 opts
@@ -1289,6 +1283,19 @@ when printing the error message."
1289 ;; Unknown arglist. 1283 ;; Unknown arglist.
1290 (t '(0)))) 1284 (t '(0))))
1291 1285
1286(defun byte-compile--function-signature (f)
1287 ;; Similar to help-function-arglist, except that it returns the info
1288 ;; in a different format.
1289 (and (eq 'macro (car-safe f)) (setq f (cdr f)))
1290 ;; Advice wrappers have "catch all" args, so fetch the actual underlying
1291 ;; function to find the real arguments.
1292 (while (advice--p f) (setq f (advice--cdr f)))
1293 (if (eq (car-safe f) 'declared)
1294 (byte-compile-arglist-signature (nth 1 f))
1295 (condition-case nil
1296 (let ((sig (func-arity f)))
1297 (if (numberp (cdr sig)) sig (list (car sig))))
1298 (error '(0)))))
1292 1299
1293(defun byte-compile-arglist-signatures-congruent-p (old new) 1300(defun byte-compile-arglist-signatures-congruent-p (old new)
1294 (not (or 1301 (not (or
@@ -1330,19 +1337,7 @@ when printing the error message."
1330(defun byte-compile-callargs-warn (form) 1337(defun byte-compile-callargs-warn (form)
1331 (let* ((def (or (byte-compile-fdefinition (car form) nil) 1338 (let* ((def (or (byte-compile-fdefinition (car form) nil)
1332 (byte-compile-fdefinition (car form) t))) 1339 (byte-compile-fdefinition (car form) t)))
1333 (sig (if (and def (not (eq def t))) 1340 (sig (byte-compile--function-signature def))
1334 (progn
1335 (and (eq (car-safe def) 'macro)
1336 (eq (car-safe (cdr-safe def)) 'lambda)
1337 (setq def (cdr def)))
1338 (byte-compile-arglist-signature
1339 (if (memq (car-safe def) '(declared lambda))
1340 (nth 1 def)
1341 (if (byte-code-function-p def)
1342 (aref def 0)
1343 '(&rest def)))))
1344 (if (subrp (symbol-function (car form)))
1345 (subr-arity (symbol-function (car form))))))
1346 (ncall (length (cdr form)))) 1341 (ncall (length (cdr form))))
1347 ;; Check many or unevalled from subr-arity. 1342 ;; Check many or unevalled from subr-arity.
1348 (if (and (cdr-safe sig) 1343 (if (and (cdr-safe sig)
@@ -1461,15 +1456,7 @@ extra args."
1461 (and initial (symbolp initial) 1456 (and initial (symbolp initial)
1462 (setq old (byte-compile-fdefinition initial nil))) 1457 (setq old (byte-compile-fdefinition initial nil)))
1463 (when (and old (not (eq old t))) 1458 (when (and old (not (eq old t)))
1464 (and (eq 'macro (car-safe old)) 1459 (let ((sig1 (byte-compile--function-signature old))
1465 (eq 'lambda (car-safe (cdr-safe old)))
1466 (setq old (cdr old)))
1467 (let ((sig1 (byte-compile-arglist-signature
1468 (pcase old
1469 (`(lambda ,args . ,_) args)
1470 (`(closure ,_ ,args . ,_) args)
1471 ((pred byte-code-function-p) (aref old 0))
1472 (_ '(&rest def)))))
1473 (sig2 (byte-compile-arglist-signature arglist))) 1460 (sig2 (byte-compile-arglist-signature arglist)))
1474 (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2) 1461 (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
1475 (byte-compile-set-symbol-position name) 1462 (byte-compile-set-symbol-position name)
diff --git a/lisp/files.el b/lisp/files.el
index 646387f8c86..2f3efa33c28 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1821,10 +1821,6 @@ otherwise a string <2> or <3> or ... is appended to get an unused name.
1821Emacs treats buffers whose names begin with a space as internal buffers. 1821Emacs treats buffers whose names begin with a space as internal buffers.
1822To avoid confusion when visiting a file whose name begins with a space, 1822To avoid confusion when visiting a file whose name begins with a space,
1823this function prepends a \"|\" to the final result if necessary." 1823this function prepends a \"|\" to the final result if necessary."
1824 ;; We need the following 'declare' form to shut up the byte
1825 ;; compiler, which displays a bogus warning for advised functions,
1826 ;; see bug#14860.
1827 (declare (advertised-calling-convention (filename) "18.59"))
1828 (let ((lastname (file-name-nondirectory filename))) 1824 (let ((lastname (file-name-nondirectory filename)))
1829 (if (string= lastname "") 1825 (if (string= lastname "")
1830 (setq lastname filename)) 1826 (setq lastname filename))
@@ -6594,11 +6590,6 @@ When SWITCHES contains the long `--dired' option, this function
6594treats it specially, for the sake of dired. However, the 6590treats it specially, for the sake of dired. However, the
6595normally equivalent short `-D' option is just passed on to 6591normally equivalent short `-D' option is just passed on to
6596`insert-directory-program', as any other option." 6592`insert-directory-program', as any other option."
6597 ;; We need the following 'declare' form to shut up the byte
6598 ;; compiler, which displays a bogus warning for advised functions,
6599 ;; see bug#14860.
6600 (declare (advertised-calling-convention
6601 (file switches &optional wildcard full-directory-p) "19.34"))
6602 ;; We need the directory in order to find the right handler. 6593 ;; We need the directory in order to find the right handler.
6603 (let ((handler (find-file-name-handler (expand-file-name file) 6594 (let ((handler (find-file-name-handler (expand-file-name file)
6604 'insert-directory))) 6595 'insert-directory)))
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index f5d94d8419f..cb0b2d71d33 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -564,7 +564,6 @@ FILE is the file where FUNCTION was probably defined."
564 "Return information about FUNCTION. 564 "Return information about FUNCTION.
565Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)." 565Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
566 (let* ((advised (and (symbolp function) 566 (let* ((advised (and (symbolp function)
567 (featurep 'nadvice)
568 (advice--p (advice--symbol-function function)))) 567 (advice--p (advice--symbol-function function))))
569 ;; If the function is advised, use the symbol that has the 568 ;; If the function is advised, use the symbol that has the
570 ;; real definition, if that symbol is already set up. 569 ;; real definition, if that symbol is already set up.
diff --git a/lisp/help.el b/lisp/help.el
index 0fb1c2dab77..bc7ee2c9b1b 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -1384,6 +1384,9 @@ If PRESERVE-NAMES is non-nil, return a formal arglist that uses
1384the same names as used in the original source code, when possible." 1384the same names as used in the original source code, when possible."
1385 ;; Handle symbols aliased to other symbols. 1385 ;; Handle symbols aliased to other symbols.
1386 (if (and (symbolp def) (fboundp def)) (setq def (indirect-function def))) 1386 (if (and (symbolp def) (fboundp def)) (setq def (indirect-function def)))
1387 ;; Advice wrappers have "catch all" args, so fetch the actual underlying
1388 ;; function to find the real arguments.
1389 (while (advice--p def) (setq def (advice--cdr def)))
1387 ;; If definition is a macro, find the function inside it. 1390 ;; If definition is a macro, find the function inside it.
1388 (if (eq (car-safe def) 'macro) (setq def (cdr def))) 1391 (if (eq (car-safe def) 'macro) (setq def (cdr def)))
1389 (cond 1392 (cond