diff --git a/pkgs/racket-test/tests/racket/contract/arrow.rkt b/pkgs/racket-test/tests/racket/contract/arrow.rkt index 7d822464b7..9d436e3bcc 100644 --- a/pkgs/racket-test/tests/racket/contract/arrow.rkt +++ b/pkgs/racket-test/tests/racket/contract/arrow.rkt @@ -386,6 +386,13 @@ (test/pos-blame 'predicate/c13 '(contract (-> any/c boolean?) (λ (x #:y y) #t) 'pos 'neg)) + (test/pos-blame + 'predicate/c14 + '(contract (-> any/c boolean?) + (let () + (struct s ()) + ((impersonate-procedure s? (λ (x) (values (λ (r) "") x))) 11)) + 'pos 'neg)) ;; this test ensures that no contract wrappers ;; are created for struct predicates diff --git a/racket/collects/racket/contract/private/arrow-val-first.rkt b/racket/collects/racket/contract/private/arrow-val-first.rkt index 84bf657b79..931eeee516 100644 --- a/racket/collects/racket/contract/private/arrow-val-first.rkt +++ b/racket/collects/racket/contract/private/arrow-val-first.rkt @@ -1289,7 +1289,9 @@ given: "~e") f)) (cond - [(struct-predicate-procedure? f) #f] + [(and (struct-predicate-procedure? f) + (not (impersonator? f))) + #f] [(and (equal? (procedure-arity f) 1) (let-values ([(required mandatory) (procedure-keywords f)]) (and (null? required)