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

fix chaperone-of? on bytecode-unmashaled hash tables

Browse Source 
Closes #1456
This commit is contained in:
Matthew Flatt 2016-09-08 20:22:31 -06:00
parent 558fccce98
commit ce6b9d5931
2 changed files with 38 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
pkgs/racket-test-core/tests/racket/chaperone.rktl
View File

@ -2545,6 +2545,36 @@
(test #t procedure-impersonator*? (chaperone-procedure* (chaperone-procedure values values) values)) (test #t procedure-impersonator*? (chaperone-procedure* (chaperone-procedure values values) values))
(test #f procedure-impersonator*? (chaperone-procedure (chaperone-procedure values values) values)) (test #f procedure-impersonator*? (chaperone-procedure (chaperone-procedure values values) values))
;; ----------------------------------------
;; Make sure chaperone-of works with a wrapper that appears with
;; hash tables read from bytecode
(let ([o (open-output-bytes)])
(write (compile '#hash(("a" . "b"))) o)
(define h (eval (parameterize ([read-accept-compiled #t])
(read (open-input-bytes (get-output-bytes o))))))
(define h2 #hash(("a" . "b")))
(test #t equal? h h2)
(test #t chaperone-of? h h2)
(test #t chaperone-of? h2 h)
(test #t impersonator-of? h h2)
(test #t impersonator-of? h2 h)
(define (check-combo h h2)
(define ch (chaperone-hash h
(lambda (h k) (values k (lambda (h k v) v)))
(lambda (h k v) (values k v))
(lambda (h k) k) (lambda (h k) k)))
(test #t chaperone-of? ch h)
(test #t chaperone-of? ch h2)
(test #f chaperone-of? h ch)
(test #f chaperone-of? h2 ch)
(test #t impersonator-of? ch h)
(test #t impersonator-of? ch h2)
(test #f impersonator-of? h ch)
(test #f impersonator-of? h2 ch))
(check-combo h h2)
(check-combo h2 h))
;; ---------------------------------------- ;; ----------------------------------------
(report-errs) (report-errs)

14
racket/src/racket/src/bool.c
View File

@ -611,20 +611,22 @@ int is_equal (Scheme_Object *obj1, Scheme_Object *obj2, Equal_Info *eql)
t2 = SCHEME_TYPE(obj2); t2 = SCHEME_TYPE(obj2);
if (NOT_SAME_TYPE(t1, t2)) { if (NOT_SAME_TYPE(t1, t2)) {
if (t1 == scheme_hash_tree_indirection_type) {
obj1 = (Scheme_Object *)scheme_hash_tree_resolve_placeholder((Scheme_Hash_Tree *)obj1);
goto top_after_next;
}
if (t2 == scheme_hash_tree_indirection_type) {
obj2 = (Scheme_Object *)scheme_hash_tree_resolve_placeholder((Scheme_Hash_Tree *)obj2);
goto top_after_next;
}
if (!eql->for_chaperone) { if (!eql->for_chaperone) {
if (SCHEME_CHAPERONEP(obj1)) { if (SCHEME_CHAPERONEP(obj1)) {
obj1 = ((Scheme_Chaperone *)obj1)->val; obj1 = ((Scheme_Chaperone *)obj1)->val;
goto top_after_next; goto top_after_next;
} else if (t1 == scheme_hash_tree_indirection_type) {
obj1 = (Scheme_Object *)scheme_hash_tree_resolve_placeholder((Scheme_Hash_Tree *)obj1);
goto top_after_next;
} }
if (SCHEME_CHAPERONEP(obj2)) { if (SCHEME_CHAPERONEP(obj2)) {
obj2 = ((Scheme_Chaperone *)obj2)->val; obj2 = ((Scheme_Chaperone *)obj2)->val;
goto top_after_next; goto top_after_next;
} else if (t2 == scheme_hash_tree_indirection_type) {
obj2 = (Scheme_Object *)scheme_hash_tree_resolve_placeholder((Scheme_Hash_Tree *)obj2);
goto top_after_next;
} }
} }
return 0; return 0;