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

Merge branch 'master' of git.racket-lang.org:plt

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2010-05-05 10:26:26 -04:00
commit 5b97a0d6d2
2 changed files with 22 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -533,6 +533,8 @@
;; Avoid printign hash-table argument, which implicitly uses `ref': ;; Avoid printign hash-table argument, which implicitly uses `ref':
(let ([got (apply proc args)]) (let ([got (apply proc args)])
(test #t (format "~s ~s ~s" proc val got) (equal? val got))))]) (test #t (format "~s ~s ~s" proc val got) (equal? val got))))])
(test #f hash-iterate-first h1)
(test #f hash-iterate-first h2)
(test #f hash-ref h1 'key #f) (test #f hash-ref h1 'key #f)
(test '(#f #f #f #f #f #f) list get-k get-v set-k set-v remove-k access-k) (test '(#f #f #f #f #f #f) list get-k get-v set-k set-v remove-k access-k)
(test 'nope hash-ref h2 'key 'nope) (test 'nope hash-ref h2 'key 'nope)
@ -540,6 +542,9 @@
(set! get-k #f) (set! get-k #f)
(test (void) hash-set! h1 'key 'val) (test (void) hash-set! h1 'key 'val)
(test '(#f #f #f #f #f #f) list get-k get-v set-k set-v remove-k access-k) (test '(#f #f #f #f #f #f) list get-k get-v set-k set-v remove-k access-k)
(test #f not (hash-iterate-first h1))
(test #f not (hash-iterate-first h2))
(test #f hash-iterate-next h2 (hash-iterate-first h2))
(test 'val hash-ref h1 'key #f) (test 'val hash-ref h1 'key #f)
(test '(#f #f #f #f #f #f) list get-k get-v set-k set-v remove-k access-k) (test '(#f #f #f #f #f #f) list get-k get-v set-k set-v remove-k access-k)
(test 'val hash-ref h2 'key #f) (test 'val hash-ref h2 'key #f)
@ -723,4 +728,10 @@
;; ---------------------------------------- ;; ----------------------------------------
(test #t equal?
(chaperone-procedure add1 void)
(chaperone-procedure add1 void))
;; ----------------------------------------
(report-errs) (report-errs)

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

@ -2397,11 +2397,16 @@ static Scheme_Object *hash_table_for_each(int argc, Scheme_Object *argv[])
static Scheme_Object *hash_table_next(const char *name, int start, int argc, Scheme_Object *argv[]) static Scheme_Object *hash_table_next(const char *name, int start, int argc, Scheme_Object *argv[])
{ {
if (SCHEME_HASHTP(argv[0])) { Scheme_Object *o = argv[0];
if (SCHEME_NP_CHAPERONEP(o))
o = SCHEME_CHAPERONE_VAL(o);
if (SCHEME_HASHTP(o)) {
Scheme_Hash_Table *hash; Scheme_Hash_Table *hash;
int i, sz; int i, sz;
hash = (Scheme_Hash_Table *)argv[0]; hash = (Scheme_Hash_Table *)o;
sz = hash->size; sz = hash->size;
if (start >= 0) { if (start >= 0) {
@ -2414,21 +2419,21 @@ static Scheme_Object *hash_table_next(const char *name, int start, int argc, Sch
} }
return scheme_false; return scheme_false;
} else if (SCHEME_HASHTRP(argv[0])) { } else if (SCHEME_HASHTRP(o)) {
int v; int v;
v = scheme_hash_tree_next((Scheme_Hash_Tree *)argv[0], start); v = scheme_hash_tree_next((Scheme_Hash_Tree *)o, start);
if (v == -1) if (v == -1)
return scheme_false; return scheme_false;
else if (v == -2) else if (v == -2)
return NULL; return NULL;
else else
return scheme_make_integer(v); return scheme_make_integer(v);
} else if (SCHEME_BUCKTP(argv[0])) { } else if (SCHEME_BUCKTP(o)) {
Scheme_Bucket_Table *hash; Scheme_Bucket_Table *hash;
Scheme_Bucket *bucket; Scheme_Bucket *bucket;
int i, sz; int i, sz;
hash = (Scheme_Bucket_Table *)argv[0]; hash = (Scheme_Bucket_Table *)o;
sz = hash->size; sz = hash->size;