fix unsafe-immutable-hash-...
on hash table from read
When `read` parses a literal hash table, it inserts an placeholder just in case it's needed for cycles. The `unsafe-immutable-hash-...` operations in some cases did not detect and remove the placeholder. Closes #1376 Merge to v6.6
This commit is contained in:
parent
ad2c229af1
commit
ca6c67be68
|
@ -679,4 +679,18 @@
|
||||||
(err/rt-test
|
(err/rt-test
|
||||||
(unsafe-weak-hash-iterate-next ht i) exn:fail:contract? err-msg)))
|
(unsafe-weak-hash-iterate-next ht i) exn:fail:contract? err-msg)))
|
||||||
|
|
||||||
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
;; Check that `unsafe-immutable-hash-...` proplerly handles an
|
||||||
|
;; indirection created by `read`:
|
||||||
|
|
||||||
|
(test '((a . 1) (b . 2))
|
||||||
|
sort
|
||||||
|
(for/list (((k v) (in-immutable-hash (read (open-input-string "#hash((a . 1) (b . 2))")))))
|
||||||
|
(cons k v))
|
||||||
|
<
|
||||||
|
#:key cdr)
|
||||||
|
|
||||||
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(report-errs)
|
(report-errs)
|
||||||
|
|
|
@ -2885,6 +2885,7 @@ XFORM_NONGCING void scheme_unsafe_hash_tree_subtree(Scheme_Object *obj, Scheme_O
|
||||||
subtree = (Scheme_Hash_Tree *)SCHEME_CHAPERONE_VAL(obj);
|
subtree = (Scheme_Hash_Tree *)SCHEME_CHAPERONE_VAL(obj);
|
||||||
else
|
else
|
||||||
subtree = (Scheme_Hash_Tree *)obj;
|
subtree = (Scheme_Hash_Tree *)obj;
|
||||||
|
subtree = resolve_placeholder(subtree);
|
||||||
i = SCHEME_INT_VAL(args);
|
i = SCHEME_INT_VAL(args);
|
||||||
while (i >= (1<<(2*mzHAMT_LOG_WORD_SIZE))) {
|
while (i >= (1<<(2*mzHAMT_LOG_WORD_SIZE))) {
|
||||||
subtree = (Scheme_Hash_Tree *)subtree->els[i & ((1<<mzHAMT_LOG_WORD_SIZE)-1)];
|
subtree = (Scheme_Hash_Tree *)subtree->els[i & ((1<<mzHAMT_LOG_WORD_SIZE)-1)];
|
||||||
|
@ -2916,6 +2917,7 @@ Scheme_Object *scheme_unsafe_hash_tree_next(Scheme_Hash_Tree *ht, Scheme_Object
|
||||||
stack = SCHEME_CDDR(args);
|
stack = SCHEME_CDDR(args);
|
||||||
level = -1; /* -1 = too big */
|
level = -1; /* -1 = too big */
|
||||||
} else {
|
} else {
|
||||||
|
ht = resolve_placeholder(ht);
|
||||||
i = SCHEME_INT_VAL(args);
|
i = SCHEME_INT_VAL(args);
|
||||||
level = 0;
|
level = 0;
|
||||||
while (i >= (1<<(2*mzHAMT_LOG_WORD_SIZE))) {
|
while (i >= (1<<(2*mzHAMT_LOG_WORD_SIZE))) {
|
||||||
|
@ -2928,8 +2930,6 @@ Scheme_Object *scheme_unsafe_hash_tree_next(Scheme_Hash_Tree *ht, Scheme_Object
|
||||||
i = i & ((1<<mzHAMT_LOG_WORD_SIZE)-1);
|
i = i & ((1<<mzHAMT_LOG_WORD_SIZE)-1);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* ht = resolve_placeholder(ht); /\* only check this in iterate-first *\/ */
|
|
||||||
|
|
||||||
while (1) {
|
while (1) {
|
||||||
if (!i) { /* pop up the tree */
|
if (!i) { /* pop up the tree */
|
||||||
if (level == -1) {
|
if (level == -1) {
|
||||||
|
|
Loading…
Reference in New Issue
Block a user