diff --git a/pkgs/racket-test-core/tests/racket/chaperone.rktl b/pkgs/racket-test-core/tests/racket/chaperone.rktl index e43bfbb3f2..d9b75d2819 100644 --- a/pkgs/racket-test-core/tests/racket/chaperone.rktl +++ b/pkgs/racket-test-core/tests/racket/chaperone.rktl @@ -2495,6 +2495,38 @@ 'neg)]) (f 6))))) +;; ---------------------------------------- +;; Check that property-only impersonator does not +;; interfere with `chaperone-of?` +;; (Test provided by Vincent) + +(let () + (define-values (prop has-prop? get-prop) + (make-impersonator-property 'prop)) + + (define add1* (impersonate-procedure add1 #f + prop #f)) + + (test #t chaperone-of? (chaperone-procedure add1* #f) + add1*) + (test #t chaperone-of? (chaperone-procedure add1* (lambda (x) x)) + add1*) + + (test #f chaperone-of? (chaperone-procedure add1* #f) + add1) + (test #f chaperone-of? (chaperone-procedure add1* (lambda (x) x)) + add1) + + (test #t impersonator-of? (chaperone-procedure add1* #f) + add1*) + (test #t impersonator-of? (chaperone-procedure add1* (lambda (x) x)) + add1*) + + (test #t impersonator-of? (chaperone-procedure add1* #f) + add1) + (test #t impersonator-of? (chaperone-procedure add1* (lambda (x) x)) + add1)) + ;; ---------------------------------------- (report-errs) diff --git a/racket/src/racket/src/bool.c b/racket/src/racket/src/bool.c index a1ea1e22dd..6a6fa9ce68 100644 --- a/racket/src/racket/src/bool.c +++ b/racket/src/racket/src/bool.c @@ -575,6 +575,8 @@ int is_equal (Scheme_Object *obj1, Scheme_Object *obj2, Equal_Info *eql) if (eql->for_chaperone && SCHEME_CHAPERONEP(obj2) + && (!(SCHEME_CHAPERONE_FLAGS((Scheme_Chaperone *)obj2) & SCHEME_CHAPERONE_IS_IMPERSONATOR) + || (eql->for_chaperone > 1)) && scheme_is_noninterposing_chaperone(obj2)) { obj2 = ((Scheme_Chaperone *)obj2)->prev; goto top_after_next;