diff --git a/pkgs/racket-test-core/tests/racket/chaperone.rktl b/pkgs/racket-test-core/tests/racket/chaperone.rktl index 450926924b..0c7ccddaa6 100644 --- a/pkgs/racket-test-core/tests/racket/chaperone.rktl +++ b/pkgs/racket-test-core/tests/racket/chaperone.rktl @@ -2545,6 +2545,36 @@ (test #t 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) diff --git a/racket/src/racket/src/bool.c b/racket/src/racket/src/bool.c index 431cecbf64..c27b3fc085 100644 --- a/racket/src/racket/src/bool.c +++ b/racket/src/racket/src/bool.c @@ -611,20 +611,22 @@ int is_equal (Scheme_Object *obj1, Scheme_Object *obj2, Equal_Info *eql) t2 = SCHEME_TYPE(obj2); 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 (SCHEME_CHAPERONEP(obj1)) { obj1 = ((Scheme_Chaperone *)obj1)->val; 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)) { obj2 = ((Scheme_Chaperone *)obj2)->val; 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;