diff options
| author | Stefan Monnier | 2017-07-14 11:27:21 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2017-07-14 11:27:21 -0400 |
| commit | 6e2d6d54e1236216462c13655ea1fe573d9672e7 (patch) | |
| tree | a5e1af3e57a5d1c3c7bf7828a60f6ab7c6e28f68 | |
| parent | 583995c62dd424775dda33d5134ce04bee2ae685 (diff) | |
| download | emacs-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.el | 43 | ||||
| -rw-r--r-- | lisp/files.el | 9 | ||||
| -rw-r--r-- | lisp/help-fns.el | 1 | ||||
| -rw-r--r-- | lisp/help.el | 3 |
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. | |||
| 1821 | Emacs treats buffers whose names begin with a space as internal buffers. | 1821 | Emacs treats buffers whose names begin with a space as internal buffers. |
| 1822 | To avoid confusion when visiting a file whose name begins with a space, | 1822 | To avoid confusion when visiting a file whose name begins with a space, |
| 1823 | this function prepends a \"|\" to the final result if necessary." | 1823 | this 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 | |||
| 6594 | treats it specially, for the sake of dired. However, the | 6590 | treats it specially, for the sake of dired. However, the |
| 6595 | normally equivalent short `-D' option is just passed on to | 6591 | normally 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. |
| 565 | Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)." | 565 | Returns 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 | |||
| 1384 | the same names as used in the original source code, when possible." | 1384 | the 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 |