hash-set! on weak tables returns the value

* libguile/weak-table.h:
* libguile/weak-table.c (scm_weak_table_putq_x)
  (scm_weak_table_remq_x, scm_weak_table_clear_x)
  (scm_weak_table_for_each): Declare these as returning void instead of
  SCM.
* libguile/hashtab.c (scm_hashq_set_x, scm_hashq_remove_x)
  (scm_hashv_set_x, scm_hashv_remove_x)
  (scm_hash_set_x, scm_hash_remove_x)
  (scm_hashx_set_x, scm_hashx_remove_x):
  (scm_hash_for_each): For weak tables, have the set! functions return
  the values, as they used to do.  Have remove! functions return #f,
  indicating the lack of a handle.  Shim around for-each to return
  unspecified, even though that wasn't yet a problem.

* test-suite/tests/weaks.test: Add a test.

4 files changed, 47 insertions, 26 deletions

diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index d01df763b..fc7fa424e 100644
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -356,7 +356,10 @@ SCM_DEFINE (scm_hash_clear_x, "hash-clear!", 1, 0, 0,
 #define FUNC_NAME s_scm_hash_clear_x
 {
   if (SCM_WEAK_TABLE_P (table))
-    return scm_weak_table_clear_x (table);
+    {
+      scm_weak_table_clear_x (table);
+      return SCM_UNSPECIFIED;
+    }
 
   SCM_VALIDATE_HASHTABLE (SCM_ARG1, table);
 
@@ -430,7 +433,10 @@ SCM_DEFINE (scm_hashq_set_x, "hashq-set!", 3, 0, 0,
 #define FUNC_NAME s_scm_hashq_set_x
 {
   if (SCM_WEAK_TABLE_P (table))
-    return scm_weak_table_putq_x (table, key, val);
+    {
+      scm_weak_table_putq_x (table, key, val);
+      return val;
+    }
 
   return scm_hash_fn_set_x (table, key, val,
 			    (scm_t_hash_fn) scm_ihashq,
@@ -448,7 +454,14 @@ SCM_DEFINE (scm_hashq_remove_x, "hashq-remove!", 2, 0, 0,
 #define FUNC_NAME s_scm_hashq_remove_x
 {
   if (SCM_WEAK_TABLE_P (table))
-    return scm_weak_table_remq_x (table, key);
+    {
+      scm_weak_table_remq_x (table, key);
+      /* This return value is for historical compatibility with
+         hash-remove!, which returns either the "handle" corresponding
+         to the entry, or #f.  Since weak tables don't have handles, we
+         have to return #f.  */
+      return SCM_BOOL_F;
+    }
 
   return scm_hash_fn_remove_x (table, key,
 			       (scm_t_hash_fn) scm_ihashq,
@@ -532,7 +545,7 @@ SCM_DEFINE (scm_hashv_set_x, "hashv-set!", 3, 0, 0,
       scm_c_weak_table_put_x (table, scm_ihashv (key, -1),
                               assv_predicate, SCM_PACK (key),
                               key, val);
-      return SCM_UNSPECIFIED;
+      return val;
     }
 
   return scm_hash_fn_set_x (table, key, val,
@@ -553,7 +566,8 @@ SCM_DEFINE (scm_hashv_remove_x, "hashv-remove!", 2, 0, 0,
     {
       scm_c_weak_table_remove_x (table, scm_ihashv (key, -1),
                                  assv_predicate, SCM_PACK (key));
-      return SCM_UNSPECIFIED;
+      /* See note in hashq-remove!.  */
+      return SCM_BOOL_F;
     }
 
   return scm_hash_fn_remove_x (table, key,
@@ -638,7 +652,7 @@ SCM_DEFINE (scm_hash_set_x, "hash-set!", 3, 0, 0,
       scm_c_weak_table_put_x (table, scm_ihash (key, -1),
                               assoc_predicate, SCM_PACK (key),
                               key, val);
-      return SCM_UNSPECIFIED;
+      return val;
     }
 
   return scm_hash_fn_set_x (table, key, val,
@@ -660,7 +674,8 @@ SCM_DEFINE (scm_hash_remove_x, "hash-remove!", 2, 0, 0,
     {
       scm_c_weak_table_remove_x (table, scm_ihash (key, -1),
                                  assoc_predicate, SCM_PACK (key));
-      return SCM_UNSPECIFIED;
+      /* See note in hashq-remove!.  */
+      return SCM_BOOL_F;
     }
 
   return scm_hash_fn_remove_x (table, key,
@@ -812,7 +827,7 @@ SCM_DEFINE (scm_hashx_set_x, "hashx-set!", 5, 0, 0,
       unsigned long h = scm_to_ulong (scm_call_2 (hash, key,
                                                   scm_from_ulong (-1)));
       scm_c_weak_table_put_x (table, h, assx_predicate, &closure, key, val);
-      return SCM_UNSPECIFIED;
+      return val;
     }
 
   return scm_hash_fn_set_x (table, key, val, scm_ihashx, scm_sloppy_assx,
@@ -843,7 +858,8 @@ SCM_DEFINE (scm_hashx_remove_x, "hashx-remove!", 4, 0, 0,
       unsigned long h = scm_to_ulong (scm_call_2 (hash, obj,
                                                   scm_from_ulong (-1)));
       scm_c_weak_table_remove_x (table, h, assx_predicate, &closure);
-      return SCM_UNSPECIFIED;
+      /* See note in hashq-remove!.  */
+      return SCM_BOOL_F;
     }
 
   return scm_hash_fn_remove_x (table, obj, scm_ihashx, scm_sloppy_assx,
@@ -893,7 +909,10 @@ SCM_DEFINE (scm_hash_for_each, "hash-for-each", 2, 0, 0,
   SCM_VALIDATE_PROC (1, proc);
 
   if (SCM_WEAK_TABLE_P (table))
-    return scm_weak_table_for_each (proc, table);
+    {
+      scm_weak_table_for_each (proc, table);
+      return SCM_UNSPECIFIED;
+    }
 
   SCM_VALIDATE_HASHTABLE (2, table);
   
diff --git a/libguile/weak-table.c b/libguile/weak-table.c
index 7764f5254..6a3fecd3e 100644
--- a/libguile/weak-table.c
+++ b/libguile/weak-table.c
@@ -971,24 +971,22 @@ scm_weak_table_refq (SCM table, SCM key, SCM dflt)
                                dflt);
 }
 
-SCM
+void
 scm_weak_table_putq_x (SCM table, SCM key, SCM value)
 {
   scm_c_weak_table_put_x (table, scm_ihashq (key, -1),
                           assq_predicate, SCM_UNPACK_POINTER (key),
                           key, value);
-  return SCM_UNSPECIFIED;
 }
 
-SCM
+void
 scm_weak_table_remq_x (SCM table, SCM key)
 {
   scm_c_weak_table_remove_x (table, scm_ihashq (key, -1),
                              assq_predicate, SCM_UNPACK_POINTER (key));
-  return SCM_UNSPECIFIED;
 }
 
-SCM
+void
 scm_weak_table_clear_x (SCM table)
 #define FUNC_NAME "weak-table-clear!"
 {
@@ -1004,8 +1002,6 @@ scm_weak_table_clear_x (SCM table)
   t->n_items = 0;
 
   scm_i_pthread_mutex_unlock (&t->lock);
-
-  return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
@@ -1073,7 +1069,7 @@ for_each_trampoline (void *closure, SCM k, SCM v, SCM seed)
   return seed;
 }
 
-SCM
+void
 scm_weak_table_for_each (SCM proc, SCM table)
 #define FUNC_NAME "weak-table-for-each"
 {
@@ -1081,8 +1077,6 @@ scm_weak_table_for_each (SCM proc, SCM table)
   SCM_VALIDATE_PROC (1, proc);
 
   scm_c_weak_table_fold (for_each_trampoline, SCM_UNPACK_POINTER (proc), SCM_BOOL_F, table);
-
-  return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
diff --git a/libguile/weak-table.h b/libguile/weak-table.h
index cb2831c3a..f516c2601 100644
--- a/libguile/weak-table.h
+++ b/libguile/weak-table.h
@@ -3,7 +3,7 @@
 #ifndef SCM_WEAK_TABLE_H
 #define SCM_WEAK_TABLE_H
 
-/* Copyright (C) 2011 Free Software Foundation, Inc.
+/* Copyright (C) 2011, 2012 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -58,15 +58,15 @@ SCM_INTERNAL void scm_c_weak_table_remove_x (SCM table, unsigned long raw_hash,
                                              void *closure);
 
 SCM_INTERNAL SCM scm_weak_table_refq (SCM table, SCM key, SCM dflt);
-SCM_INTERNAL SCM scm_weak_table_putq_x (SCM table, SCM key, SCM value);
-SCM_INTERNAL SCM scm_weak_table_remq_x (SCM table, SCM key);
+SCM_INTERNAL void scm_weak_table_putq_x (SCM table, SCM key, SCM value);
+SCM_INTERNAL void scm_weak_table_remq_x (SCM table, SCM key);
 
-SCM_INTERNAL SCM scm_weak_table_clear_x (SCM table);
+SCM_INTERNAL void scm_weak_table_clear_x (SCM table);
 
 SCM_INTERNAL SCM scm_c_weak_table_fold (scm_t_table_fold_fn proc, void *closure,
                                       SCM init, SCM table);
 SCM_INTERNAL SCM scm_weak_table_fold (SCM proc, SCM init, SCM table);
-SCM_INTERNAL SCM scm_weak_table_for_each (SCM proc, SCM table);
+SCM_INTERNAL void scm_weak_table_for_each (SCM proc, SCM table);
 SCM_INTERNAL SCM scm_weak_table_map_to_list (SCM proc, SCM table);
 
 
diff --git a/test-suite/tests/weaks.test b/test-suite/tests/weaks.test
index 9475eed55..1d53fc422 100644
--- a/test-suite/tests/weaks.test
+++ b/test-suite/tests/weaks.test
@@ -1,5 +1,5 @@
 ;;;; weaks.test --- tests guile's weaks     -*- scheme -*-
-;;;; Copyright (C) 1999, 2001, 2003, 2006, 2009, 2010, 2011 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2001, 2003, 2006, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -232,6 +232,14 @@
        (hash-set! t "foo" 1)
        (equal? (hash-ref t "foo") 1)))
 
+   (pass-if "hash-set!, weak key, returns value"
+     (let ((t (make-weak-value-hash-table))
+           (val (string #\f #\o #\o)))
+       (eq? (hashq-set! t "bar" val)
+            (hashv-set! t "bar" val)
+            (hash-set! t "bar" val)
+            val)))
+
    (pass-if "assoc can do anything"
             ;; Until 1.9.12, as hash table's custom ASSOC procedure was
             ;; called with the GC lock alloc held, which imposed severe