add #:generate keyword to build-flat-contract-property

the public function was missing the `#:generate` keyword, added this and documented why `#:exercise` is missing
LiberalArtist · Apr 9, 2017 · 3bb131e · 3bb131e
1 parent d224da3
commit 3bb131e
Show file tree

Hide file tree

Showing 3 changed files with 61 additions and 17 deletions.
diff --git 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
@@ -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
@@ -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))