Bug in assq/v/oc-remove! primitives (with patch)

[Neil Jerram]

I think I've found a bug in assq-remove! and friends.  My
understanding is that

(assq/v/oc-remove! alist key1)

should remove all entries from the alist whose *key* is
eq?/eqv?/equal? to key1.

In fact, with the current CVS implementation, the effect is to remove
all entries where the *whole entry* (key . value) is eq?/eqv?/equal?
to the first entry whose key is eq?/eqv?/equal? to key1.

To illustrate, current CVS gives:

guile> (define address-list '())
guile> (set! address-list (assq-set! address-list "mary" "11 Elm Street"))
guile> (set! address-list (assq-set! address-list "mary" "57 Pine Drive"))
guile> address-list
(("mary" . "57 Pine Drive") ("mary" . "11 Elm Street"))
guile> (set! address-list (assoc-remove! address-list "mary"))
guile> address-list
(("mary" . "11 Elm Street"))

With my patch below, you get:

guile> (define address-list '())
guile> (set! address-list (assq-set! address-list "mary" "11 Elm Street"))
guile> (set! address-list (assq-set! address-list "mary" "57 Pine Drive"))
guile> address-list
(("mary" . "57 Pine Drive") ("mary" . "11 Elm Street"))
guile> (set! address-list (assoc-remove! address-list "mary"))
guile> address-list
()

Best regards,

     Neil

Index: alist.c
===================================================================
RCS file: /cvs/guile/guile/guile-core/libguile/alist.c,v
retrieving revision 1.25
diff -u -r1.25 alist.c
--- alist.c     2000/05/08 11:53:01     1.25
+++ alist.c     2000/07/23 07:59:03
@@ -331,19 +331,19 @@
             (SCM alist, SCM key),
            "@deffnx primitive assv-remove! alist key\n"
            "@deffnx primitive assoc-remove! alist key\n"
-           "Delete any entry in @var{alist} associated with @var{key}, and return\n"
+           "Delete all entries in @var{alist} associated with @var{key}, and return\n"
            "the resulting alist.")
 #define FUNC_NAME s_scm_assq_remove_x
 {
   SCM handle;
 
   handle = scm_sloppy_assq (key, alist);
-  if (SCM_CONSP (handle))
+  while (SCM_CONSP (handle))
     {
-      return scm_delq_x (handle, alist);
+      alist = scm_delq_x (handle, alist);
+      handle = scm_sloppy_assq (key, alist);
     }
-  else
-    return alist;
+  return alist;
 }
 #undef FUNC_NAME
 
@@ -356,12 +356,12 @@
   SCM handle;
 
   handle = scm_sloppy_assv (key, alist);
-  if (SCM_CONSP (handle))
+  while (SCM_CONSP (handle))
     {
-      return scm_delv_x (handle, alist);
+      alist = scm_delq_x (handle, alist);
+      handle = scm_sloppy_assv (key, alist);
     }
-  else
-    return alist;
+  return alist;
 }
 #undef FUNC_NAME
 
@@ -374,12 +374,12 @@
   SCM handle;
 
   handle = scm_sloppy_assoc (key, alist);
-  if (SCM_CONSP (handle))
+  while (SCM_CONSP (handle))
     {
-      return scm_delete_x (handle, alist);
+      alist = scm_delq_x (handle, alist);
+      handle = scm_sloppy_assoc (key, alist);
     }
-  else
-    return alist;
+  return alist;
 }
 #undef FUNC_NAME