suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix hash proxying in the case that proxied key has no value

Browse Source
This commit is contained in:
Matthew Flatt 2010-09-10 12:38:37 -06:00
parent 2c9f8cebbd
commit ff9b535dc6
3 changed files with 107 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/scribblings/reference/chaperones.scrbl
View File

@ -291,6 +291,12 @@ other operations that use @scheme[hash-iterate-key] internally); it
must produce a replacement for the key, which is then reported as a
key extracted from the table.
The @racket[hash-iterate-value], @racket[hash-map], or
@racket[hash-for-each] functions use a combination of
@racket[hash-iterate-key] and @racket[hash-ref]. If a key
produced by @scheme[key-proc] does not yield a value through
@racket[hash-ref], then the @exnraise[exn:fail:contract].
Pairs of @scheme[prop] and @scheme[prop-val] (the number of arguments
to @scheme[proxy-hash] must be odd) add proxy properties
or override proxy-property values of @scheme[hash].}

44
collects/tests/racket/chaperone.rktl
View File

@ -828,6 +828,50 @@
;; ----------------------------------------
;; Check broken key proxy:
(let ([check
(lambda (orig)
(let ([h (proxy-hash
orig
(λ (h k)
(values 'bad1
(λ (h k v)
'bad2)))
(λ (h k v) (values 'bad3 'bad4))
(λ (h k) 'bad5)
(λ (h k) 'bad6))])
(test (void) hash-set! h 1 2)
(test #f hash-ref h 1 #f)
(err/rt-test (hash-iterate-value h (hash-iterate-first h)))
(err/rt-test (hash-map h void))
(err/rt-test (hash-for-each h void))))])
(check (make-hash))
(check (make-hasheq))
(check (make-weak-hash))
(check (make-weak-hasheq)))
(let ([check
(lambda (orig)
(let ([h (chaperone-hash
orig
(λ (h k)
(values (chaperone-vector k (lambda (b i v) v) (lambda (b i v) v))
(λ (h k v) v)))
(λ (h k v) (values (chaperone-vector k (lambda (b i v) v) (lambda (b i v) v))
v))
(λ (h k) (chaperone-vector k (lambda (b i v) v) (lambda (b i v) v)))
(λ (h k) (chaperone-vector k (lambda (b i v) v) (lambda (b i v) v))))])
(let* ([vec (vector 1 2 3)]
[h (hash-set h vec 2)])
(test #f hash-ref h vec #f)
(err/rt-test (hash-iterate-value h (hash-iterate-first h)))
(err/rt-test (hash-map h void))
(err/rt-test (hash-for-each h void)))))])
(check (hasheq)))
;; ----------------------------------------
(let ()
(define-struct a (x y) #:transparent)
(let* ([a1 (make-a 1 2)]

70
src/racket/src/list.c
View File

@ -2021,7 +2021,8 @@ static Scheme_Object *hash_table_copy(int argc, Scheme_Object *argv[])
scheme_hash_tree_index(t, i, &k, &val);
if (!SAME_OBJ((Scheme_Object *)t, v))
val = scheme_chaperone_hash_traversal_get(v, k);
scheme_hash_set(naya, k, val);
if (val)
scheme_hash_set(naya, k, val);
}
return (Scheme_Object *)naya;
@ -2330,6 +2331,11 @@ static Scheme_Object *do_map_hash_table(int argc,
v = chaperone_hash_key(name, chaperone, p[0]);
p[0] = v;
v = scheme_chaperone_hash_get(chaperone, v);
if (!v)
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: no value found for post-proxy key: %V",
name,
p[0]);
} else
v = (Scheme_Object *)bucket->val;
if (v) {
@ -2359,6 +2365,11 @@ static Scheme_Object *do_map_hash_table(int argc,
v = chaperone_hash_key(name, chaperone, p[0]);
p[0] = v;
v = scheme_chaperone_hash_get(chaperone, v);
if (!v)
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: no value found for post-proxy key: %V",
name,
p[0]);
} else {
v = hash->vals[i];
}
@ -2391,6 +2402,11 @@ static Scheme_Object *do_map_hash_table(int argc,
if (chaperone) {
ik = chaperone_hash_key(name, chaperone, ik);
iv = scheme_chaperone_hash_get(chaperone, ik);
if (!iv)
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: no value found for post-chaperone key: %V",
name,
ik);
}
if (iv) {
p[1] = iv;
@ -2524,7 +2540,7 @@ static Scheme_Object *hash_table_iterate_next(int argc, Scheme_Object *argv[])
static Scheme_Object *hash_table_index(const char *name, int argc, Scheme_Object *argv[], int get_val)
{
Scheme_Object *p = argv[1], *obj, *chaperone;
Scheme_Object *p = argv[1], *obj, *chaperone, *key;
int pos, sz;
obj = argv[0];
@ -2551,9 +2567,15 @@ static Scheme_Object *hash_table_index(const char *name, int argc, Scheme_Object
if (pos < sz) {
if (hash->vals[pos]) {
if (chaperone) {
if (get_val)
return scheme_chaperone_hash_get(chaperone, chaperone_hash_key(name, chaperone, hash->keys[pos]));
else
if (get_val) {
key = chaperone_hash_key(name, chaperone, hash->keys[pos]);
obj = scheme_chaperone_hash_get(chaperone, key);
if (!obj)
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"hash-iterate-value: no value found for post-proxy key: %V",
key);
return obj;
} else
return chaperone_hash_key(name, chaperone, hash->keys[pos]);
} else if (get_val)
return hash->vals[pos];
@ -2565,9 +2587,15 @@ static Scheme_Object *hash_table_index(const char *name, int argc, Scheme_Object
Scheme_Object *v, *k;
if (scheme_hash_tree_index((Scheme_Hash_Tree *)obj, pos, &k, &v)) {
if (chaperone) {
if (get_val)
return scheme_chaperone_hash_get(chaperone, chaperone_hash_key(name, chaperone, k));
else
if (get_val) {
key = chaperone_hash_key(name, chaperone, k);
obj = scheme_chaperone_hash_get(chaperone, key);
if (!obj)
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"hash-iterate-value: no value found for post-chaperone key: %V",
key);
return obj;
} else
return chaperone_hash_key(name, chaperone, k);
} else
return (get_val ? v : k);
@ -2591,9 +2619,15 @@ static Scheme_Object *hash_table_index(const char *name, int argc, Scheme_Object
else
obj = (Scheme_Object *)bucket->key;
if (chaperone) {
if (get_val)
return scheme_chaperone_hash_get(chaperone, chaperone_hash_key(name, chaperone, obj));
else
if (get_val) {
key = chaperone_hash_key(name, chaperone, obj);
obj = scheme_chaperone_hash_get(chaperone, key);
if (!obj)
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"hash-iterate-value: no value found for post-proxy key: %V",
key);
return obj;
} else
return chaperone_hash_key(name, chaperone, obj);
} else
return obj;
@ -2709,7 +2743,12 @@ static Scheme_Object *chaperone_hash_op_k(void)
p->ku.k.p3 = NULL;
p->ku.k.p4 = NULL;
return chaperone_hash_op(who, o, k, v, p->ku.k.i1);
o = chaperone_hash_op(who, o, k, v, p->ku.k.i1);
if (!o)
return scheme_false;
else
return scheme_box(o);
}
static Scheme_Object *chaperone_hash_op_overflow(const char *who, Scheme_Object *o, Scheme_Object *k,
@ -2723,7 +2762,12 @@ static Scheme_Object *chaperone_hash_op_overflow(const char *who, Scheme_Object
p->ku.k.p4 = (void *)who;
p->ku.k.i1 = mode;
return scheme_handle_stack_overflow(chaperone_hash_op_k);
o = scheme_handle_stack_overflow(chaperone_hash_op_k);
if (SCHEME_FALSEP(o))
return NULL;
else
return SCHEME_BOX_VAL(o);
}
static Scheme_Object *chaperone_hash_op(const char *who, Scheme_Object *o, Scheme_Object *k,