bug#10146: error in aput in assoc.el, Emacs 24, 23, and 22 (at least)

[Christopher Genovese <genovese.cr@gmail.com>]

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

The function aput in assoc.el  (within lisp/emacs-lisp) has two errors.

1. In the third case of the cond (see original below), when the alist is not
    null, the key is already in the list (and thus at the head), and the
value is not null,
    the return value is incorrect.

    The original returns the result of the setcar -- that is, the new entry
-- rather than
    the modified alist as it should.

2. The documentation string indicates that nil is returned when the list is
nil,
    but this is incorrect. The modified list is returned, which will
include the
    new key-value pair.

I have included below, in order: 1) the original function for reference, 2)
a simple
case showing the problem, and 3) a fixed version of the function. Only two
minor changes are required.

(FWIW, I'm running on Mac OS X 10.5, Emacs 24 and 23 nextstep
and Emacs 22 carbon.)


;; Original version (from the current emacs24 trunk)

(defun aput (alist-symbol key &optional value)
  "Inserts a key-value pair into an alist.
The alist is referenced by ALIST-SYMBOL.  The key-value pair is made
from KEY and optionally, VALUE.  Returns the altered alist or nil if
ALIST is nil.

If the key-value pair referenced by KEY can be found in the alist, and
VALUE is supplied non-nil, then the value of KEY will be set to VALUE.
If VALUE is not supplied, or is nil, the key-value pair will not be
modified, but will be moved to the head of the alist.  If the key-value
pair cannot be found in the alist, it will be inserted into the head
of the alist (with value nil if VALUE is nil or not supplied)."
  (lexical-let ((elem (aelement key value))
        alist)
    (asort alist-symbol key)
    (setq alist (symbol-value alist-symbol))
    (cond ((null alist) (set alist-symbol elem))
      ((anot-head-p alist key) (set alist-symbol (nconc elem alist)))
      (value (setcar alist (car elem)))
      (t alist))))

;; Simple case illustrating the problem
(require 'assoc)
(progn
  (setq tmp-alist '((a . 1)
                    (b . 2)
                    (c . 3)
                    (d . 4)))
  (setq tmp-ret1
        (aput 'tmp-alist 'e 5))  ; no problem
  (prin1 tmp-ret1)

  (print "\n")

  (setq tmp-ret2
        (aput 'tmp-alist 'b 10))    ; oops
  (prin1 tmp-ret2))

;; Fixed version of the function
;;
;; Changes:
;;   + The `values' case of the cond needs to return the
;;     alist *not* the value returned by setcar
;;   + The docstring indicating the return value has been
;;     corrected. The original was inaccurate about the
;;     case where the alist is nil.
;;
;; Note this needs (require 'cl) as in assoc.el for lexical-let

(defun aput (alist-symbol key &optional value)
  "Inserts a key-value pair into an alist.
The alist is referenced by ALIST-SYMBOL.  The key-value pair is made
from KEY and optionally, VALUE.  Returns the altered alist.

If the key-value pair referenced by KEY can be found in the alist, and
VALUE is supplied non-nil, then the value of KEY will be set to VALUE.
If VALUE is not supplied, or is nil, the key-value pair will not be
modified, but will be moved to the head of the alist.  If the key-value
pair cannot be found in the alist, it will be inserted into the head
of the alist (with value nil if VALUE is nil or not supplied)."
  (lexical-let ((elem (aelement key value))
        alist)
    (asort alist-symbol key)
    (setq alist (symbol-value alist-symbol))
    (cond ((null alist)
           (set alist-symbol elem))
      ((anot-head-p alist key)
           (set alist-symbol (nconc elem alist)))
      (value
           (setcar alist (car elem))
           alist)
      (t alist))))

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