diff --git a/pkgs/racket-doc/scribblings/reference/contracts.scrbl b/pkgs/racket-doc/scribblings/reference/contracts.scrbl index de84e929c3..4d1881d32a 100644 --- a/pkgs/racket-doc/scribblings/reference/contracts.scrbl +++ b/pkgs/racket-doc/scribblings/reference/contracts.scrbl @@ -2666,16 +2666,6 @@ returns @racket[#f] but @racket[value-blame] returns @racket[#f]. (or/c (-> (or/c contract-random-generate-fail? c)) #f))])) (λ (c) (λ (fuel) #f))] - [#:exercise - exercise - (->i ([c contract?]) - ([result - (c) - (-> (and/c positive? real?) - (values - (-> c void?) - (listof contract?)))])) - (λ (c) (λ (fuel) (values void '())))] [#:list-contract? is-list-contract? (-> contract? boolean?) (λ (c) #f)]) flat-contract-property?] @defproc[(build-chaperone-contract-property @@ -2832,15 +2822,21 @@ compared with the original, uncontracted value. A @deftech{flat contract property} specifies the behavior of a structure when used as a @tech{flat contract}. It is specified using -@racket[build-flat-contract-property], and accepts exactly the same set of -arguments as @racket[build-contract-property]. The only difference is that the -projection accessor is expected not to wrap its argument in a higher-order -fashion, analogous to the constraint on projections in -@racket[make-flat-contract]. +@racket[build-flat-contract-property], and accepts similar +arguments as @racket[build-contract-property]. The differences are: +@itemlist[ +@item{the projection accessor is expected not to wrap its argument in a + higher-order fashion, analogous to the constraint on projections in + @racket[make-flat-contract];} +@item{the @racket[#:exercise] keyword argument is omitted because it is not + relevant for flat contracts.}] @history[#:changed "6.0.1.13" @list{Added the @racket[#:list-contract?] argument.} - #:changed "6.1.1.4" - @list{Allow @racket[generate] to return @racket[contract-random-generate-fail]}] + #:changed "6.1.1.4" + @list{Allow @racket[generate] to return @racket[contract-random-generate-fail].} + #:changed "6.8.0.2" + @list{Removed the @racket[#:exercise] keyword argument from + @racket[build-flat-contract-property].}] } @deftogether[( diff --git a/pkgs/racket-test/tests/racket/contract/random-generate.rkt b/pkgs/racket-test/tests/racket/contract/random-generate.rkt index f98472e4e9..3ab888a1f3 100644 --- a/pkgs/racket-test/tests/racket/contract/random-generate.rkt +++ b/pkgs/racket-test/tests/racket/contract/random-generate.rkt @@ -364,3 +364,49 @@ (λ (x) (if x 'fail 11)) 'pos 'neg)) + +(let () ;; test generate / exercise for `build-flat-contract-property contracts + (define even-list/c + (let () + (struct ctc () + #:property + prop:flat-contract + (build-flat-contract-property + #:name (λ (c) 'even-list/c) + #:first-order (λ (c) (λ (v) (and (list? v) (andmap even? v)))) + #:late-neg-projection + (λ (c) + (λ (b) + (λ (v neg-party) + (unless (and (list? v) (andmap even? v)) + (raise-blame-error b v + #:missing-party neg-party + "expected even list, got ~v" v)) + (map values v)))))) + (ctc))) + (define even-list/c/generate + (let () + (struct ctc () + #:property + prop:flat-contract + (build-flat-contract-property + #:name (λ (c) 'even-list/c) + #:first-order (λ (c) (λ (v) (and (list? v) (andmap even? v)))) + #:late-neg-projection + (λ (c) + (λ (b) + (λ (v neg-party) + (unless (and (list? v) (andmap even? v)) + (raise-blame-error b v + #:missing-party neg-party + "expected even list, got ~v" v)) + (map values v)))) + #:generate + (λ (c) + (λ (fuel) + (λ () '(2)))))) + (ctc))) + (check-exn cannot-generate-exn? (λ () (test-contract-generation even-list/c))) + (check-not-exn (λ () (test-contract-generation even-list/c/generate))) + (check-exercise 2 void? even-list/c) + (check-exercise 2 void? even-list/c/generate)) diff --git a/racket/collects/racket/contract/combinator.rkt b/racket/collects/racket/contract/combinator.rkt index 7eb614e7c8..71e24cd4c6 100644 --- a/racket/collects/racket/contract/combinator.rkt +++ b/racket/collects/racket/contract/combinator.rkt @@ -238,6 +238,7 @@ #:val-first-projection [val-first-projection #f] #:projection [projection #f] #:stronger [stronger #f] + #:generate [generate (λ (ctc) (λ (fuel) #f))] #:list-contract? [is-list-contract #f]) (:build-flat-contract-property #:name name @@ -249,6 +250,7 @@ #:projection (and projection (λ (c) (force-projection-eq (projection c)))) #:stronger stronger + #:generate generate #:list-contract? is-list-contract))]) build-flat-contract-property))