bug#8998: 24.0.50; expand-abbrev goes into infinite loop

bug#8998: 24.0.50; expand-abbrev goes into infinite loop

[Richard Kim]

This bug report will be sent to the Bug-GNU-Emacs mailing list
and the GNU bug tracker at debbugs.gnu.org.  Please check that
the From: line contains a valid email address.  After a delay of up
to one day, you should receive an acknowledgement at that address.

Please write in English if possible, as the Emacs maintainers
usually do not have translators for other languages.

Please describe exactly what actions triggered the bug, and
the precise symptoms of the bug.  If you can, give a recipe
starting from `emacs -Q':


Abbreviation mode seems to be busted, because turning it on results in
emacs going into infinite loop.  To see the problem, start emacs-24
(latest bzr version I tested was 104955 dated July 4, 2011) like this

    emacs24 -q -l abbrev-bug.el

where the content of abbrev-bug.el is

    (setq debug-on-quit t)

    ;; Load abbrev.el rather than use abbrev.elc, so as to get
    ;; more useful stack trace.
    (load-library "abbrev.el")

    (switch-to-buffer "*scratch*")
    (abbrev-mode 1)
    (insert "a")
    (expand-abbrev)

This seems to put emacs into infinite loop, so hit Control-g to take
control which results in the stack trace shown below.


Emacs 24 bzr version 104562 dated June 11, 2011 does not suffer this
problem, so it seems to have been introduced within the past three
weeks between June 11 and July 4.


Debugger entered--Lisp error: (quit)
  (and tables (not (symbol-value sym)))
  (while (and tables (not (symbol-value sym))) (let* ((table (pop tables)) (case-fold (not (abbrev-table-get table :case-fixed)))) (setq tables (append (abbrev-table-get table :parents) tables)) (setq sym (or (intern-soft abbrev table) (when case-fold (let ((sym ...)) (and sym (not ...) sym)))))))
  (let ((tables (abbrev--active-tables table)) sym) (while (and tables (not (symbol-value sym))) (let* ((table (pop tables)) (case-fold (not (abbrev-table-get table :case-fixed)))) (setq tables (append (abbrev-table-get table :parents) tables)) (setq sym (or (intern-soft abbrev table) (when case-fold (let (...) (and sym ... sym))))))) (if (symbol-value sym) sym))
  abbrev-symbol(#("a" 0 1 (fontified nil)) [ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ...])
  (let ((abbrev (abbrev-symbol name table))) (when abbrev (setq enable-fun (abbrev-get abbrev :enable-function)) (and (or (not enable-fun) (funcall enable-fun)) (list abbrev name start end))))
  (and (or (not enable-fun) (funcall enable-fun)) (let ((re (abbrev-table-get table :regexp))) (if (null re) (let ((lim (point))) (backward-word 1) (setq start (point)) (forward-word 1) (setq end (min (point) lim))) (when (looking-back re (line-beginning-position)) (setq start (match-beginning 1)) (setq end (match-end 1))))) (setq name (buffer-substring start end)) (let ((abbrev (abbrev-symbol name table))) (when abbrev (setq enable-fun (abbrev-get abbrev :enable-function)) (and (or (not enable-fun) (funcall enable-fun)) (list abbrev name start end)))))
  (setq res (and (or (not enable-fun) (funcall enable-fun)) (let ((re (abbrev-table-get table :regexp))) (if (null re) (let ((lim (point))) (backward-word 1) (setq start (point)) (forward-word 1) (setq end (min (point) lim))) (when (looking-back re (line-beginning-position)) (setq start (match-beginning 1)) (setq end (match-end 1))))) (setq name (buffer-substring start end)) (let ((abbrev (abbrev-symbol name table))) (when abbrev (setq enable-fun (abbrev-get abbrev :enable-function)) (and (or (not enable-fun) (funcall enable-fun)) (list abbrev name start end))))))
  (let* ((table (pop tables)) (enable-fun (abbrev-table-get table :enable-function))) (setq tables (append (abbrev-table-get table :parents) tables)) (setq res (and (or (not enable-fun) (funcall enable-fun)) (let ((re (abbrev-table-get table :regexp))) (if (null re) (let ((lim ...)) (backward-word 1) (setq start (point)) (forward-word 1) (setq end (min ... lim))) (when (looking-back re (line-beginning-position)) (setq start (match-beginning 1)) (setq end (match-end 1))))) (setq name (buffer-substring start end)) (let ((abbrev (abbrev-symbol name table))) (when abbrev (setq enable-fun (abbrev-get abbrev :enable-function)) (and (or (not enable-fun) (funcall enable-fun)) (list abbrev name start end)))))) (goto-char pos))
  (while (and tables (not (car res))) (let* ((table (pop tables)) (enable-fun (abbrev-table-get table :enable-function))) (setq tables (append (abbrev-table-get table :parents) tables)) (setq res (and (or (not enable-fun) (funcall enable-fun)) (let ((re (abbrev-table-get table :regexp))) (if (null re) (let (...) (backward-word 1) (setq start ...) (forward-word 1) (setq end ...)) (when (looking-back re ...) (setq start ...) (setq end ...)))) (setq name (buffer-substring start end)) (let ((abbrev (abbrev-symbol name table))) (when abbrev (setq enable-fun (abbrev-get abbrev :enable-function)) (and (or ... ...) (list abbrev name start end)))))) (goto-char pos)))
  (if abbrev-start-location (progn (setq start abbrev-start-location) (setq abbrev-start-location nil) (if (and (< start (point-max)) (eq (char-after start) 45)) (delete-region start (1+ start))) (skip-syntax-backward " ") (setq end (point)) (when (> end start) (setq name (buffer-substring start end)) (goto-char pos) (list (abbrev-symbol name tables) name start end))) (while (and tables (not (car res))) (let* ((table (pop tables)) (enable-fun (abbrev-table-get table :enable-function))) (setq tables (append (abbrev-table-get table :parents) tables)) (setq res (and (or (not enable-fun) (funcall enable-fun)) (let ((re ...)) (if (null re) (let ... ... ... ... ...) (when ... ... ...))) (setq name (buffer-substring start end)) (let ((abbrev ...)) (when abbrev (setq enable-fun ...) (and ... ...))
 ))) (goto-char pos))) res)
  (let ((tables (abbrev--active-tables)) (pos (point)) start end name res) (if abbrev-start-location (progn (setq start abbrev-start-location) (setq abbrev-start-location nil) (if (and (< start (point-max)) (eq (char-after start) 45)) (delete-region start (1+ start))) (skip-syntax-backward " ") (setq end (point)) (when (> end start) (setq name (buffer-substring start end)) (goto-char pos) (list (abbrev-symbol name tables) name start end))) (while (and tables (not (car res))) (let* ((table (pop tables)) (enable-fun (abbrev-table-get table :enable-function))) (setq tables (append (abbrev-table-get table :parents) tables)) (setq res (and (or (not enable-fun) (funcall enable-fun)) (let (...) (if ... ... ...)) (setq name (buffer-substring start end)) (let (...) (when abbrev ... ...)))) (goto-ch
 ar pos))) res))
  abbrev--before-point()
  (let* ((--cl-rest-- (abbrev--before-point)) (sym (pop --cl-rest--)) (name (pop --cl-rest--)) (wordstart (pop --cl-rest--)) (wordend (pop --cl-rest--))) (if --cl-rest-- (signal (quote wrong-number-of-arguments) (list nil (+ 4 (length --cl-rest--))))) (when sym (unless (or noninteractive (window-minibuffer-p (selected-window))) (undo-boundary)) (setq last-abbrev-text name) (setq last-abbrev sym) (setq last-abbrev-location wordstart) (abbrev-insert sym name wordstart wordend)))
  (progn (let* ((--cl-rest-- (abbrev--before-point)) (sym (pop --cl-rest--)) (name (pop --cl-rest--)) (wordstart (pop --cl-rest--)) (wordend (pop --cl-rest--))) (if --cl-rest-- (signal (quote wrong-number-of-arguments) (list nil (+ 4 (length --cl-rest--))))) (when sym (unless (or noninteractive (window-minibuffer-p (selected-window))) (undo-boundary)) (setq last-abbrev-text name) (setq last-abbrev sym) (setq last-abbrev-location wordstart) (abbrev-insert sym name wordstart wordend))))
  (destructuring-bind (&optional sym name wordstart wordend) (abbrev--before-point) (when sym (unless (or noninteractive (window-minibuffer-p (selected-window))) (undo-boundary)) (setq last-abbrev-text name) (setq last-abbrev sym) (setq last-abbrev-location wordstart) (abbrev-insert sym name wordstart wordend)))
  (closure ((args) (global) (funs) (runrestofhook closure (#2 t) (funs global args) (if (consp funs) (if (eq t (car funs)) (funcall runrestofhook (append global (cdr funs)) nil args) (apply (car funs) (apply-partially (lambda ... ...) (cdr funs) global) args)) (apply (lambda nil (destructuring-bind (&optional sym name wordstart wordend) (abbrev--before-point) (when sym ... ... ... ... ...))) args))) t) nil (destructuring-bind (&optional sym name wordstart wordend) (abbrev--before-point) (when sym (unless (or noninteractive (window-minibuffer-p (selected-window))) (undo-boundary)) (setq last-abbrev-text name) (setq last-abbrev sym) (setq last-abbrev-location wordstart) (abbrev-insert sym name wordstart wordend))))()
  apply((closure ((args) (global) (funs) (runrestofhook closure (#2 t) (funs global args) (if (consp funs) (if (eq t (car funs)) (funcall runrestofhook (append global (cdr funs)) nil args) (apply (car funs) (apply-partially (lambda ... ...) (cdr funs) global) args)) (apply (lambda nil (destructuring-bind (&optional sym name wordstart wordend) (abbrev--before-point) (when sym ... ... ... ... ...))) args))) t) nil (destructuring-bind (&optional sym name wordstart wordend) (abbrev--before-point) (when sym (unless (or noninteractive (window-minibuffer-p (selected-window))) (undo-boundary)) (setq last-abbrev-text name) (setq last-abbrev sym) (setq last-abbrev-location wordstart) (abbrev-insert sym name wordstart wordend)))) nil)
  (if (consp funs) (if (eq t (car funs)) (funcall runrestofhook (append global (cdr funs)) nil args) (apply (car funs) (apply-partially (lambda (funs global &rest args) (funcall runrestofhook funs global args)) (cdr funs) global) args)) (apply (lambda nil (destructuring-bind (&optional sym name wordstart wordend) (abbrev--before-point) (when sym (unless (or noninteractive (window-minibuffer-p ...)) (undo-boundary)) (setq last-abbrev-text name) (setq last-abbrev sym) (setq last-abbrev-location wordstart) (abbrev-insert sym name wordstart wordend)))) args))
  (closure ((runrestofhook closure #1 (funs global args) (if (consp funs) (if (eq t (car funs)) (funcall runrestofhook (append global (cdr funs)) nil args) (apply (car funs) (apply-partially (lambda ... ...) (cdr funs) global) args)) (apply (lambda nil (destructuring-bind (&optional sym name wordstart wordend) (abbrev--before-point) (when sym ... ... ... ... ...))) args))) t) (funs global args) (if (consp funs) (if (eq t (car funs)) (funcall runrestofhook (append global (cdr funs)) nil args) (apply (car funs) (apply-partially (lambda (funs global &rest args) (funcall runrestofhook funs global args)) (cdr funs) global) args)) (apply (lambda nil (destructuring-bind (&optional sym name wordstart wordend) (abbrev--before-point) (when sym (unless (or noninteractive ...) (undo-boundary)) (setq l
 ast-abbrev-text name) (setq last-abbrev sym) (setq last-abbrev-location wordstart) (abbrev-insert sym name wordstart wordend)))) args)))(nil nil nil)
  funcall((closure ((runrestofhook closure #1 (funs global args) (if (consp funs) (if (eq t (car funs)) (funcall runrestofhook (append global (cdr funs)) nil args) (apply (car funs) (apply-partially (lambda ... ...) (cdr funs) global) args)) (apply (lambda nil (destructuring-bind (&optional sym name wordstart wordend) (abbrev--before-point) (when sym ... ... ... ... ...))) args))) t) (funs global args) (if (consp funs) (if (eq t (car funs)) (funcall runrestofhook (append global (cdr funs)) nil args) (apply (car funs) (apply-partially (lambda (funs global &rest args) (funcall runrestofhook funs global args)) (cdr funs) global) args)) (apply (lambda nil (destructuring-bind (&optional sym name wordstart wordend) (abbrev--before-point) (when sym (unless (or noninteractive ...) (undo-boundary))
  (setq last-abbrev-text name) (setq last-abbrev sym) (setq last-abbrev-location wordstart) (abbrev-insert sym name wordstart wordend)))) args))) nil nil nil)
  (let (runrestofhook) (setq runrestofhook (lambda (funs global args) (if (consp funs) (if (eq t (car funs)) (funcall runrestofhook (append global (cdr funs)) nil args) (apply (car funs) (apply-partially (lambda ... ...) (cdr funs) global) args)) (apply (lambda nil (destructuring-bind (&optional sym name wordstart wordend) (abbrev--before-point) (when sym ... ... ... ... ...))) args)))) (funcall runrestofhook abbrev-expand-functions (if (local-variable-p (quote abbrev-expand-functions)) (default-value (quote abbrev-expand-functions))) (list)))
  (letrec ((runrestofhook (lambda (funs global args) (if (consp funs) (if (eq t (car funs)) (funcall runrestofhook (append global ...) nil args) (apply (car funs) (apply-partially ... ... global) args)) (apply (lambda nil (destructuring-bind ... ... ...)) args))))) (funcall runrestofhook abbrev-expand-functions (if (local-variable-p (quote abbrev-expand-functions)) (default-value (quote abbrev-expand-functions))) (list)))
  (with-wrapper-hook abbrev-expand-functions nil (destructuring-bind (&optional sym name wordstart wordend) (abbrev--before-point) (when sym (unless (or noninteractive (window-minibuffer-p (selected-window))) (undo-boundary)) (setq last-abbrev-text name) (setq last-abbrev sym) (setq last-abbrev-location wordstart) (abbrev-insert sym name wordstart wordend))))
  expand-abbrev()
  eval-buffer(#<buffer  *load*> nil "/home/kimr/.emacs24-abbrev-bug" nil t)  ; Reading at buffer position 215
  load-with-code-conversion("/home/kimr/.emacs24-abbrev-bug" "/home/kimr/.emacs24-abbrev-bug" nil t)
  load("/home/kimr/.emacs24-abbrev-bug" nil t)
  command-line-1(("-l" "/home/kimr/.emacs24-abbrev-bug"))
  command-line()
  normal-top-level()


If Emacs crashed, and you have the Emacs process in the gdb debugger,
please include the output from the following gdb commands:
    `bt full' and `xbacktrace'.
For information about debugging Emacs, please read the file
/home/kimr/src/emacs-bzr/trunk_20110704/etc/DEBUG.


In GNU Emacs 24.0.50.1 (i686-pc-linux-gnu, GTK+ Version 2.24.4)
 of 2011-07-04 on kimr-laptop
Windowing system distributor `The X.Org Foundation', version 11.0.11001000
Important settings:
  value of $LC_ALL: nil
  value of $LC_COLLATE: nil
  value of $LC_CTYPE: nil
  value of $LC_MESSAGES: nil
  value of $LC_MONETARY: nil
  value of $LC_NUMERIC: nil
  value of $LC_TIME: nil
  value of $LANG: en_US.UTF-8
  value of $XMODIFIERS: nil
  locale-coding-system: utf-8-unix
  default enable-multibyte-characters: t

Major mode: Debugger

Minor modes in effect:
  tooltip-mode: t
  mouse-wheel-mode: t
  tool-bar-mode: t
  menu-bar-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  blink-cursor-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t
  line-number-mode: t
  transient-mark-mode: t

Recent input:
ESC < C-x 1 <help-echo> ESC x r e p o r t - SPC <tab> 
<return>

Recent messages:
For information about GNU Emacs and the GNU system, type C-h C-a.
Loading /u/kimr/src/emacs-bzr/emacs24_latest/lisp/abbrev.el (source)...done
Entering debugger...
Mark set

Load-path shadows:
None found.

Features:
(shadow sort gnus-util mail-extr message sendmail regexp-opt format-spec
rfc822 mml mml-sec mm-decode mm-bodies mm-encode mail-parse rfc2231
rfc2047 rfc2045 ietf-drums mm-util mail-prsvr mailabbrev mail-utils
gmm-utils mailheader emacsbug help-mode easymenu view debug easy-mmode
cl time-date tooltip ediff-hook vc-hooks lisp-float-type mwheel x-win
x-dnd tool-bar dnd fontset image fringe lisp-mode register page menu-bar
rfn-eshadow timer select scroll-bar mouse jit-lock font-lock syntax
facemenu font-core frame cham georgian utf-8-lang misc-lang vietnamese
tibetan thai tai-viet lao korean japanese hebrew greek romanian slovak
czech european ethiopic indian cyrillic chinese case-table epa-hook
jka-cmpr-hook help simple abbrev minibuffer loaddefs button faces
cus-face files text-properties overlay sha1 md5 base64 format env
code-pages mule custom widget hashtable-print-readable backquote
make-network-process dbusbind dynamic-setting system-font-setting
font-render-setting move-toolbar gtk x-toolkit x multi-tty emacs)

bug#8998: culprit found

[emacs18]

I think the infinite loop problem that I reported was introduced by
revision 104853 shown below.


=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog	2011-07-01 13:37:00 +0000
+++ lisp/ChangeLog	2011-07-01 16:41:02 +0000
@@ -1,3 +1,8 @@
+2011-07-01  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* emacs-lisp/derived.el (define-derived-mode): Make abbrev-table
+	inherit from parent.
+
 2011-07-01  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
 	* dired-aux.el (dired-diff): Doc fixup (bug#8816).

=== modified file 'lisp/emacs-lisp/derived.el'
--- lisp/emacs-lisp/derived.el	2011-03-22 20:58:27 +0000
+++ lisp/emacs-lisp/derived.el	2011-07-01 16:41:02 +0000
@@ -253,8 +253,11 @@
 		   `(let ((parent (char-table-parent ,syntax)))
 		      (unless (and parent
 				   (not (eq parent (standard-syntax-table))))
-			(set-char-table-parent ,syntax (syntax-table)))))))
-
+			(set-char-table-parent ,syntax (syntax-table)))))
+                ,(when declare-abbrev
+                   `(unless (abbrev-table-get ,abbrev :parents)
+                      (abbrev-table-put ,abbrev :parents
+                                        (list local-abbrev-table))))))
 	  (use-local-map ,map)
 	  ,(when syntax `(set-syntax-table ,syntax))
 	  ,(when abbrev `(setq local-abbrev-table ,abbrev))

bug#8998: further analysis of the problem

[emacs18]

I did some further investigation and have more information to share.

The recent change made in `define-derived-mode' adds :parents abbrev
property to the derived mode's abbrev table, e.g.,
`lisp-interaction-mode-abbrev-table'.  Unfortunately this results in
cyclic data where :parent abbrev property of
lisp-interaction-mode-abbrev-table is itself, i.e., the following is
true:

  (eq 
   lisp-interaction-mode-abbrev-table
   (car (abbrev-table-get lisp-interaction-mode-abbrev-table :parents)))

This cyclic relationship (i.e., being its own parent) causes infinite
loop within `abbrev-symbol' which has code similar to this:

  (while tables
    (setq table (pop tables))
    (setq tables (append (abbrev-table-get table :parents) tables))
    ...)

This loop within `abbrev-symbol' in conjunction with
lisp-interaction-mode-abbrev-table being its own parent causes the
infinite loop.

Why is `lisp-interaction-mode-abbrev-table' its own parent?
I think the answer is that the following items have something to do with
it.

A. lisp-interaction-mode and emacs-lisp-mode are both defined via 
   define-derived-mode macro.

B. Both modes call `lisp-mode-variables' utility function which sets
   local-abbrev-table.

C. define-derived-mode macro uses local-abbrev-table as the value of
   parent *before* setting it, i.e., it uses the value of
   local-abbrev-table (whatever it is) as the parent!

I hope this helps.

bug#8998: #8999 seems to be duplicate of #8998

[Richard Kim]

[-- Attachment #1: Type: text/plain, Size: 133 bytes --]

Both #8998 and #8999 report inifinite loop with abbrev mode.

See the analysis at the bottom of #8998 for the cause of this problem.

[-- Attachment #2: Type: text/html, Size: 147 bytes --]

bug#8998: further analysis of the problem

[Stefan Monnier]

> Why is `lisp-interaction-mode-abbrev-table' its own parent?

I've installed the patch below which I believe fixes the problem.
Can you confirm that it fixes the problem for you?


        Stefan


=== modified file 'lisp/emacs-lisp/derived.el'
--- lisp/emacs-lisp/derived.el	2011-07-01 16:41:02 +0000
+++ lisp/emacs-lisp/derived.el	2011-07-05 18:23:08 +0000
@@ -255,7 +255,10 @@
 				   (not (eq parent (standard-syntax-table))))
 			(set-char-table-parent ,syntax (syntax-table)))))
                 ,(when declare-abbrev
-                   `(unless (abbrev-table-get ,abbrev :parents)
+                   `(unless (or (abbrev-table-get ,abbrev :parents)
+                                ;; This can happen if the major mode defines
+                                ;; the abbrev-table to be its parent's.
+                                (eq ,abbrev local-abbrev-table))
                       (abbrev-table-put ,abbrev :parents
                                         (list local-abbrev-table))))))
 	  (use-local-map ,map)

=== modified file 'lisp/emacs-lisp/lisp-mode.el'
--- lisp/emacs-lisp/lisp-mode.el	2011-06-28 12:09:43 +0000
+++ lisp/emacs-lisp/lisp-mode.el	2011-07-05 16:14:45 +0000
@@ -525,7 +525,6 @@
   "Keymap for Lisp Interaction mode.
 All commands in `lisp-mode-shared-map' are inherited by this map.")
 
-(defvar lisp-interaction-mode-abbrev-table lisp-mode-abbrev-table)
 (define-derived-mode lisp-interaction-mode emacs-lisp-mode "Lisp Interaction"
   "Major mode for typing and evaluating Lisp forms.
 Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression

bug#8998: further analysis of the problem

[Stefan Monnier]

> Yes, it does the solve the problem.  Thanks.

Great, thanks,


        Stefan