[Emacs-diffs] master 6e2d6d5: * lisp/emacs-lisp/bytecomp.el: Fix bug#14860.

[Stefan Monnier]

branch: master
commit 6e2d6d54e1236216462c13655ea1fe573d9672e7
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    * 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.
---
 lisp/emacs-lisp/bytecomp.el | 43 +++++++++++++++----------------------------
 lisp/files.el               |  9 ---------
 lisp/help-fns.el            |  1 -
 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 e5b9b47..fdd4276 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -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)
diff --git a/lisp/files.el b/lisp/files.el
index 646387f..2f3efa3 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.
 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)))
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index f5d94d8..cb0b2d7 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -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.
diff --git a/lisp/help.el b/lisp/help.el
index 0fb1c2d..bc7ee2c 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
 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