add #:generate
keyword to build-flat-contract-property
the public function was missing the `#:generate` keyword, added this and documented why `#:exercise` is missing
This commit is contained in:
parent
d224da3105
commit
3bb131ecb2
|
@ -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]}]
|
||||
@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[(
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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))
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user