From e765231dadb428688ce12e9ca66b48835dba07e4 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 9 Jul 2011 20:09:41 -0600
Subject: [PATCH] fix `hash-ref' bugs on immutable `eq?'-based tables

 There were two:
   * new: after finding a hash code, the key wasn't
          always checked to be `eq?' to the desired key
   * old: the hash code wan't downshifted by 2, so
          changes in the low two bits (like when a pair
          is determined to start a list) could break
          lookup

 Merge to 5.1.2
---
 collects/tests/racket/basic.rktl | 21 ++++++++++++++++++---
 src/racket/src/hash.c            |  4 +++-
 src/racket/src/thread.c          |  8 +-------
 3 files changed, 22 insertions(+), 11 deletions(-)

diff --git a/collects/tests/racket/basic.rktl b/collects/tests/racket/basic.rktl
index 4ad4079938..b9f75d6254 100644
--- a/collects/tests/racket/basic.rktl
+++ b/collects/tests/racket/basic.rktl
@@ -2388,9 +2388,11 @@
   (check-all-bad hash-iterate-key)
   (check-all-bad hash-iterate-value))
 
-(test (list 1 2 3) hash-keys #hasheq((1 . a)(2 . b)(3 . c)))
-(test (list 'a 'b 'c) hash-values #hasheq((1 . a)(2 . b)(3 . c)))
-(test (list (cons 1 'a) (cons 2 'b) (cons 3 'c)) hash->list #hasheq((1 . a)(2 . b)(3 . c)))
+(test (list 1 2 3) sort (hash-keys #hasheq((1 . a) (2 . b) (3 . c))) <)
+(test (list 'a 'b 'c) 
+      sort (hash-values #hasheq((1 . a) (2 . b) (3 . c))) string<? #:key symbol->string)
+(test (list (cons 1 'a) (cons 2 'b) (cons 3 'c)) 
+      sort (hash->list #hasheq((1 . a) (2 . b) (3 . c))) < #:key car)
 
 (err/rt-test (hash-set*! im-t 1 2) exn:fail?)
 (err/rt-test (hash-set* (make-hasheq null) 1 2) exn:fail?)
@@ -2495,6 +2497,19 @@
     (test (equal-hash-code ht) values (equal-hash-code ht2))
     (test (equal-secondary-hash-code ht) values (equal-secondary-hash-code ht2))))
 
+;; Check that immutable hash trees aren't confused by an
+;; "is a list" bit set in a key:
+(let ()
+  (define p (list 1 2 3 4))
+  (define ht (hasheq p 1 'a 7 'b 10 'c 13))
+  (test 1 hash-ref ht p #f)
+  (list? p)
+  (list? p)
+  (list? (list* 1 2 p))
+  (list? (list* 1 2 p))
+  (list? (list* 1 2 p))
+  (test 1 hash-ref ht p #f))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Misc
 
diff --git a/src/racket/src/hash.c b/src/racket/src/hash.c
index b4d3174aec..cd2a8623bd 100644
--- a/src/racket/src/hash.c
+++ b/src/racket/src/hash.c
@@ -2276,6 +2276,7 @@ Scheme_Hash_Tree *scheme_hash_tree_set(Scheme_Hash_Tree *tree, Scheme_Object *ke
     }
   } else {
     h = PTR_TO_LONG((Scheme_Object *)key);
+    h = h >> 2;
   }
 
   if (!val) {
@@ -2417,6 +2418,7 @@ Scheme_Object *scheme_eq_hash_tree_get(Scheme_Hash_Tree *tree, Scheme_Object *ke
   RBNode *rb;
 
   h = PTR_TO_LONG((Scheme_Object *)key);
+  h = h >> 2;
 
   rb = rb_find(h, tree->root);
   if (rb) {
@@ -2429,7 +2431,7 @@ Scheme_Object *scheme_eq_hash_tree_get(Scheme_Hash_Tree *tree, Scheme_Object *ke
           return SCHEME_CDR(a);
         prs = SCHEME_CDR(prs);
       }
-    } else
+    } else if (SAME_OBJ(rb->key, key))
       return rb->val;
   }
 
diff --git a/src/racket/src/thread.c b/src/racket/src/thread.c
index c198bc4b34..a8ee52fabe 100644
--- a/src/racket/src/thread.c
+++ b/src/racket/src/thread.c
@@ -258,12 +258,6 @@ typedef struct Thread_Cell {
   Scheme_Object so;
   char inherited, assigned;
   Scheme_Object *def_val;
-  /* A thread's thread_cell table maps cells to keys weakly.
-     This table maps keys to values weakly. The two weak
-     levels ensure that thread cells are properly GCed
-     when the value of a thread cell references the thread
-     cell. */
-  Scheme_Bucket_Table *vals;
 } Thread_Cell;
 
 #ifdef MZ_PRECISE_GC
@@ -6436,7 +6430,7 @@ static Scheme_Object *do_param(void *_data, int argc, Scheme_Object *argv[])
 
   pos[0] = data->key;
   pos[1] = data->defcell;
-  
+
   return scheme_param_config("parameter-procedure", 
 			     (Scheme_Object *)(void *)pos,
 			     argc, argv2,