diff --git a/collects/scheme/private/contract.ss b/collects/scheme/private/contract.ss index c786c45f9e..e3e44173b8 100644 --- a/collects/scheme/private/contract.ss +++ b/collects/scheme/private/contract.ss @@ -1277,6 +1277,7 @@ improve method arity mismatch contract violation error messages? (null? x) (number? x) (regexp? x) + (prefab-struct-key x) ;; this cannot be last, since it doesn't return just #t (and (pair? x) (printable? (car x)) (printable? (cdr x))) diff --git a/collects/tests/mzscheme/contract-test.ss b/collects/tests/mzscheme/contract-test.ss index 270844d5ba..65ef9dfd1c 100644 --- a/collects/tests/mzscheme/contract-test.ss +++ b/collects/tests/mzscheme/contract-test.ss @@ -4524,6 +4524,9 @@ so that propagation occurs. (test-flat-contract 'false/c #f #t) (test/spec-passed 'any/c '(contract any/c 1 'pos 'neg)) (test-flat-contract 'printable/c (vector (cons 1 (box #f))) (lambda (x) x)) + (let () + (define-struct s (a b) #:prefab) + (test-flat-contract 'printable/c (make-s 1 2) (λ (x) x))) (test-flat-contract '(symbols 'a 'b 'c) 'a 'd) (test-flat-contract '(one-of/c (expt 2 65)) (expt 2 65) 12) (test-flat-contract '(one-of/c '#:x '#:z) '#:x '#:y)