From 58da0f87134145943c7edb5639f80ff5f65fe2e0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Tue, 28 May 2019 09:08:16 +0200
Subject: [PATCH] weak hash tables: fix regression with gethash

while fixing problem in sethash I've introduced another one in
gethash. A comment is added to prevent such mistakes.
---
 src/c/hash.d                           | 16 +++++-----
 src/tests/normal-tests/hash-tables.lsp | 42 +++++++++++++++++++++++++-
 2 files changed, 48 insertions(+), 10 deletions(-)

diff --git a/src/c/hash.d b/src/c/hash.d
index d38aaa158..31b7d9efa 100644
--- a/src/c/hash.d
+++ b/src/c/hash.d
@@ -605,7 +605,9 @@ normalize_weak_key_and_value_entry(struct ecl_hashtable_entry *e) {
 
 static void *
 normalize_weak_key_or_value_entry(struct ecl_hashtable_entry *e) {
-  if ((e->key = e->key->weak.value) || (e->value = e->value->weak.value))
+  e->key = e->key->weak.value;
+  e->value = e->value->weak.value;
+  if (e->key || e->value)
     return (void*)e;
   else
     return 0;
@@ -716,14 +718,10 @@ _ecl_gethash_weak(cl_object key, cl_object hashtable, cl_object def)
   if (aux->key == OBJNULL) {
     return def;
   }
-  switch (hashtable->hash.weak) {
-  case ecl_htt_weak_value:
-  case ecl_htt_weak_key_or_value:
-  case ecl_htt_weak_key_and_value:
-    return si_weak_pointer_value(aux->value);
-  default:
-    return aux->value;
-  }
+  /* _ecl_weak_hash_loop "normalizes" entries. That means that
+     si_weak_pointer_value shouldn't be called because value is
+     already "unwrapped". -- jd 2019-05-28 */
+  return aux->value;
 }
 
 static cl_object
diff --git a/src/tests/normal-tests/hash-tables.lsp b/src/tests/normal-tests/hash-tables.lsp
index c9f2e5355..1e979040c 100644
--- a/src/tests/normal-tests/hash-tables.lsp
+++ b/src/tests/normal-tests/hash-tables.lsp
@@ -62,8 +62,48 @@
       (is k 'random-state)
       (is v 'random-state))))
 
+;;; For some corner cases weak hash-tables returned unnormalized
+;;; values. Then we had a regression in gethash which tried to
+;;; normalize already normalized values. We clearly need a simple test
+;;; whenever hash tables work correctly.
+(test hash-tables.weak-faithful
+      (let ((hts (list (make-hash-table :weakness nil)
+                       (make-hash-table :weakness :key)
+                       (make-hash-table :weakness :value)
+                       (make-hash-table :weakness :key-or-value)
+                       (make-hash-table :weakness :key-and-value)))
+            (keys (list :a :b :c))
+            (vals (list :x :y :z)))
+        ;; ensure basic set/get on null entries
+        (mapc (lambda (ht)
+                (mapc (lambda (k v)
+                        (is (null (gethash k ht)))
+                        (setf (gethash k ht) v)
+                        (is (eql (gethash k ht) v)
+                            "gethash ~s = ~s, should be ~s, weakness is ~s"
+                            k (gethash k ht) v (ext:hash-table-weakness ht)))
+                      keys vals))
+              hts)
+        ;; ensure that values get updated for a known key
+        (mapc (lambda (ht)
+                (setf (gethash :c ht) :z-prim)
+                (is (eql (gethash :c ht) :z-prim)))
+              hts)
+        ;; ensure maphash
+        (mapc (lambda (ht)
+                (let ((i 0))
+                  (maphash (lambda (k v)
+                             (incf i)
+                             (is (eql v (ecase k
+                                          (:a :x)
+                                          (:b :y)
+                                          (:c :z-prim)))))
+                           ht)
+                  (is (= i 3))))
+              hts)))
+
 (test hash-tables.weak-err
-  (signals simple-type-error (make-hash-table :weakness :whatever)))
+      (signals simple-type-error (make-hash-table :weakness :whatever)))
 
 
 ;;; Synchronization