bug#17564: 24.4.50; REGRESSION: (wrong-type-argument arrayp C-source)

[Drew Adams <drew.adams@oracle.com>]

The code of `describe-function-1' seems to have changed to cause this
regression.  In this sexp of `describe-function-1':

(and (or (byte-code-function-p def)
         (keymapp def)
         (memq (car-safe def) '(macro lambda closure)))
     file-name
     (help-fns--autoloaded-p function file-name))

if the FUNCTION has been redefined, as below, each of the `and' clauses
returns non-nil leading up to `help-fns--autoloaded-p', and that
function fails because it is given `C-source' as its FILE-NAME arg.

emacs -Q

Evaluate this:

(or (fboundp '1on1-ORIG-top-level)
    (fset '1on1-ORIG-top-level (symbol-function 'top-level)))

(defun top-level ()
  "Exit all recursive editing levels."
  (interactive)
  ;; (1on1-color-minibuffer-frame-on-exit)
  (1on1-ORIG-top-level))

C-h f top-level

You get this backtrace:

Debugger entered--Lisp error: (wrong-type-argument arrayp C-source)
  file-truename(C-source)
  (file-name-sans-extension (file-truename file))
  (let* ((file (file-name-sans-extension (file-truename file))) (load-hist =
load-history) (target (cons t function)) found) (while (and load-hist (not =
found)) (and (caar load-hist) (equal (file-name-sans-extension (caar load-h=
ist)) file) (setq found (member target (cdar load-hist)))) (setq load-hist =
(cdr load-hist))) found)
  (closure (t) (function file) "Return non-nil if FUNCTION has previously b=
een autoloaded.\nFILE is the file where FUNCTION was probably defined." (le=
t* ((file (file-name-sans-extension (file-truename file))) (load-hist load-=
history) (target (cons t function)) found) (while (and load-hist (not found=
)) (and (caar load-hist) (equal (file-name-sans-extension (caar load-hist))=
 file) (setq found (member target (cdar load-hist)))) (setq load-hist (cdr =
load-hist))) found))(top-level C-source)
  apply((closure (t) (function file) "Return non-nil if FUNCTION has previo=
usly been autoloaded.\nFILE is the file where FUNCTION was probably defined=
." (let* ((file (file-name-sans-extension (file-truename file))) (load-hist=
 load-history) (target (cons t function)) found) (while (and load-hist (not=
 found)) (and (caar load-hist) (equal (file-name-sans-extension (caar load-=
hist)) file) (setq found (member target (cdar load-hist)))) (setq load-hist=
 (cdr load-hist))) found)) (top-level C-source))
* help-fns--autoloaded-p(top-level C-source)
  (and (or (byte-code-function-p def) (keymapp def) (memq (car-safe def) (q=
uote (macro lambda closure)))) file-name (help-fns--autoloaded-p function f=
ile-name))
  (if (and (or (byte-code-function-p def) (keymapp def) (memq (car-safe def=
) (quote (macro lambda closure)))) file-name (help-fns--autoloaded-p functi=
on file-name)) (if (commandp def) "an interactive autoloaded " "an autoload=
ed ") (if (commandp def) "an interactive " "a "))
  (let* ((advised (and (symbolp function) (featurep (quote nadvice)) (advic=
e--p (advice--symbol-function function)))) (real-function (or (and advised =
(advice--cd*r (advice--symbol-function function))) function)) (def (if (sym=
bolp real-function) (symbol-function real-function) real-function)) (aliase=
d (or (symbolp def) (and advised (symbolp real-function)))) (real-def (cond=
 (aliased (let ((f real-function)) (while (and ... ...) (setq f ...)) f)) (=
(subrp def) (intern (subr-name def))) (t def))) (file-name (find-lisp-objec=
t-file-name function def)) (pt1 (save-current-buffer (set-buffer (help-buff=
er)) (point))) (beg (if (and (or (byte-code-function-p def) (keymapp def) (=
memq (car-safe def) (quote ...))) file-name (help-fns--autoloaded-p functio=
n file-name)) (if (commandp def) "an interactive autoloaded " "an autoloade=
d ") (if (commandp def) "an interactive " "a ")))) (princ (cond ((or (strin=
gp def) (vectorp def)) "a keyboard macro") ((subrp def) (if (eq (quote unev=
alled) (cdr (subr-arity def))) (concat beg "special form") (concat beg "bui=
lt-in function"))) (aliased (format "an alias for `%s'" real-def)) ((autolo=
adp def) (format "%s autoloaded %s" (if (commandp def) "an interactive" "an=
") (if (eq (nth 4 def) (quote keymap)) "keymap" (if (nth 4 def) "Lisp macro=
" "Lisp function")))) ((or (eq (car-safe def) (quote macro)) (macrop functi=
on)) (concat beg "Lisp macro")) ((byte-code-function-p def) (concat beg "co=
mpiled Lisp function")) ((eq (car-safe def) (quote lambda)) (concat beg "Li=
sp function")) ((eq (car-safe def) (quote closure)) (concat beg "Lisp closu=
re")) ((keymapp def) (let ((is-full nil) (elts (cdr-safe def))) (while elts=
 (if (char-table-p ...) (setq is-full t elts nil)) (setq elts (cdr-safe elt=
s))) (concat beg (if is-full "keymap" "sparse keymap")))) (t ""))) (if (and=
 aliased (not (fboundp real-def))) (princ ",\nwhich is not defined.  Please=
 make a bug report.") (save-current-buffer (set-buffer standard-output) (sa=
ve-excursion (let ((save-match-data-internal (match-data))) (unwind-protect=
 (progn (if ... ...)) (set-match-data save-match-data-internal (quote evapo=
rate)))))) (if file-name (progn (princ " in `") (princ (if (eq file-name (q=
uote C-source)) "C source code" (file-name-nondirectory file-name))) (princ=
 "'") (save-current-buffer (set-buffer standard-output) (save-excursion (re=
-search-backward "`\\([^`']+\\)'" nil t) (help-xref-button 1 (quote help-fu=
nction-def) function file-name))))) (princ ".") (save-current-buffer (set-b=
uffer (help-buffer)) (fill-region-as-paragraph (save-excursion (goto-char p=
t1) (forward-line 0) (point)) (point))) (terpri) (terpri) (let* ((doc-raw (=
documentation function t)) (doc (progn (and (autoloadp real-def) doc-raw he=
lp-enable-auto-load (string-match "\\([^\\]=3D\\|[^=3D]\\|\\`\\)\\\\[[{<]" =
doc-raw) (load ... t)) (substitute-command-keys doc-raw)))) (help-fns--key-=
bindings function) (save-current-buffer (set-buffer standard-output) (setq =
doc (help-fns--signature function doc real-def real-function)) (run-hook-wi=
th-args (quote help-fns-describe-function-functions) function) (insert "\n"=
 (or doc "Not documented."))))))
  (closure (t) (function) (let* ((advised (and (symbolp function) (featurep=
 (quote nadvice)) (advice--p (advice--symbol-function function)))) (real-fu=
nction (or (and advised (advice--cd*r (advice--symbol-function function))) =
function)) (def (if (symbolp real-function) (symbol-function real-function)=
 real-function)) (aliased (or (symbolp def) (and advised (symbolp real-func=
tion)))) (real-def (cond (aliased (let (...) (while ... ...) f)) ((subrp de=
f) (intern (subr-name def))) (t def))) (file-name (find-lisp-object-file-na=
me function def)) (pt1 (save-current-buffer (set-buffer (help-buffer)) (poi=
nt))) (beg (if (and (or (byte-code-function-p def) (keymapp def) (memq ... =
...)) file-name (help-fns--autoloaded-p function file-name)) (if (commandp =
def) "an interactive autoloaded " "an autoloaded ") (if (commandp def) "an =
interactive " "a ")))) (princ (cond ((or (stringp def) (vectorp def)) "a ke=
yboard macro") ((subrp def) (if (eq (quote unevalled) (cdr ...)) (concat be=
g "special form") (concat beg "built-in function"))) (aliased (format "an a=
lias for `%s'" real-def)) ((autoloadp def) (format "%s autoloaded %s" (if (=
commandp def) "an interactive" "an") (if (eq ... ...) "keymap" (if ... "Lis=
p macro" "Lisp function")))) ((or (eq (car-safe def) (quote macro)) (macrop=
 function)) (concat beg "Lisp macro")) ((byte-code-function-p def) (concat =
beg "compiled Lisp function")) ((eq (car-safe def) (quote lambda)) (concat =
beg "Lisp function")) ((eq (car-safe def) (quote closure)) (concat beg "Lis=
p closure")) ((keymapp def) (let ((is-full nil) (elts ...)) (while elts (if=
 ... ...) (setq elts ...)) (concat beg (if is-full "keymap" "sparse keymap"=
)))) (t ""))) (if (and aliased (not (fboundp real-def))) (princ ",\nwhich i=
s not defined.  Please make a bug report.") (save-current-buffer (set-buffe=
r standard-output) (save-excursion (let ((save-match-data-internal ...)) (u=
nwind-protect (progn ...) (set-match-data save-match-data-internal ...)))))=
 (if file-name (progn (princ " in `") (princ (if (eq file-name ...) "C sour=
ce code" (file-name-nondirectory file-name))) (princ "'") (save-current-buf=
fer (set-buffer standard-output) (save-excursion (re-search-backward "`\\([=
^`']+\\)'" nil t) (help-xref-button 1 ... function file-name))))) (princ ".=
") (save-current-buffer (set-buffer (help-buffer)) (fill-region-as-paragrap=
h (save-excursion (goto-char pt1) (forward-line 0) (point)) (point))) (terp=
ri) (terpri) (let* ((doc-raw (documentation function t)) (doc (progn (and .=
.. doc-raw help-enable-auto-load ... ...) (substitute-command-keys doc-raw)=
))) (help-fns--key-bindings function) (save-current-buffer (set-buffer stan=
dard-output) (setq doc (help-fns--signature function doc real-def real-func=
tion)) (run-hook-with-args (quote help-fns-describe-function-functions) fun=
ction) (insert "\n" (or doc "Not documented.")))))))(top-level)
  apply((closure (t) (function) (let* ((advised (and (symbolp function) (fe=
aturep (quote nadvice)) (advice--p (advice--symbol-function function)))) (r=
eal-function (or (and advised (advice--cd*r (advice--symbol-function functi=
on))) function)) (def (if (symbolp real-function) (symbol-function real-fun=
ction) real-function)) (aliased (or (symbolp def) (and advised (symbolp rea=
l-function)))) (real-def (cond (aliased (let (...) (while ... ...) f)) ((su=
brp def) (intern (subr-name def))) (t def))) (file-name (find-lisp-object-f=
ile-name function def)) (pt1 (save-current-buffer (set-buffer (help-buffer)=
) (point))) (beg (if (and (or (byte-code-function-p def) (keymapp def) (mem=
q ... ...)) file-name (help-fns--autoloaded-p function file-name)) (if (com=
mandp def) "an interactive autoloaded " "an autoloaded ") (if (commandp def=
) "an interactive " "a ")))) (princ (cond ((or (stringp def) (vectorp def))=
 "a keyboard macro") ((subrp def) (if (eq (quote unevalled) (cdr ...)) (con=
cat beg "special form") (concat beg "built-in function"))) (aliased (format=
 "an alias for `%s'" real-def)) ((autoloadp def) (format "%s autoloaded %s"=
 (if (commandp def) "an interactive" "an") (if (eq ... ...) "keymap" (if ..=
. "Lisp macro" "Lisp function")))) ((or (eq (car-safe def) (quote macro)) (=
macrop function)) (concat beg "Lisp macro")) ((byte-code-function-p def) (c=
oncat beg "compiled Lisp function")) ((eq (car-safe def) (quote lambda)) (c=
oncat beg "Lisp function")) ((eq (car-safe def) (quote closure)) (concat be=
g "Lisp closure")) ((keymapp def) (let ((is-full nil) (elts ...)) (while el=
ts (if ... ...) (setq elts ...)) (concat beg (if is-full "keymap" "sparse k=
eymap")))) (t ""))) (if (and aliased (not (fboundp real-def))) (princ ",\nw=
hich is not defined.  Please make a bug report.") (save-current-buffer (set=
-buffer standard-output) (save-excursion (let ((save-match-data-internal ..=
.)) (unwind-protect (progn ...) (set-match-data save-match-data-internal ..=
.))))) (if file-name (progn (princ " in `") (princ (if (eq file-name ...) "=
C source code" (file-name-nondirectory file-name))) (princ "'") (save-curre=
nt-buffer (set-buffer standard-output) (save-excursion (re-search-backward =
"`\\([^`']+\\)'" nil t) (help-xref-button 1 ... function file-name))))) (pr=
inc ".") (save-current-buffer (set-buffer (help-buffer)) (fill-region-as-pa=
ragraph (save-excursion (goto-char pt1) (forward-line 0) (point)) (point)))=
 (terpri) (terpri) (let* ((doc-raw (documentation function t)) (doc (progn =
(and ... doc-raw help-enable-auto-load ... ...) (substitute-command-keys do=
c-raw)))) (help-fns--key-bindings function) (save-current-buffer (set-buffe=
r standard-output) (setq doc (help-fns--signature function doc real-def rea=
l-function)) (run-hook-with-args (quote help-fns-describe-function-function=
s) function) (insert "\n" (or doc "Not documented."))))))) top-level)
* describe-function-1(top-level)
...

In GNU Emacs 24.4.50.1 (i686-pc-mingw32)
 of 2014-05-17 on ODIEONE
Bzr revision: 117119 eggert@cs.ucla.edu-20140517081131-ugu7ociaoec2xk7y
Windowing system distributor `Microsoft Corp.', version 6.1.7601
Configured using:
 `configure --prefix=3D/c/Devel/emacs/snapshot/trunk
 --enable-checking=3Dyes,glyphs 'CFLAGS=3D-O0 -g3'
 LDFLAGS=3D-Lc:/Devel/emacs/lib 'CPPFLAGS=3D-DGC_MCHECK=3D1
 -Ic:/Devel/emacs/include''