From aeab2420fa76ad363549ceaf632c15fd556fc4c2 Mon Sep 17 00:00:00 2001
From: shhyou <shu-hung.you@eecs.northwestern.edu>
Date: Tue, 31 Jul 2018 14:20:49 -0500
Subject: [PATCH] Fix default contract generation and exercise proc
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

The default values updated in commit ffc5720b5 do
not work for very subtle reasons. In build-contract
in racket/contract/private/prop, the default values
should not accept an extra ctc argument since ctc
is already handled by make-flat-contract. The
default gen procedure should also be (λ (fuel) #f)
instead of (λ (ctc) (λ () #f)) since the latter
would generate false when the generation should
have failed. In build-property, the default procedure
(λ (ctc) (λ (fuel) #f)) is correct and should not
be changed to (λ (ctc) (λ () #f)).
---
 .../tests/racket/contract/random-generate.rkt | 33 ++++++++++++++++---
 .../collects/racket/contract/private/prop.rkt |  6 ++--
 2 files changed, 31 insertions(+), 8 deletions(-)

diff --git a/pkgs/racket-test/tests/racket/contract/random-generate.rkt b/pkgs/racket-test/tests/racket/contract/random-generate.rkt
index 740c799d7f..3716c8f19e 100644
--- a/pkgs/racket-test/tests/racket/contract/random-generate.rkt
+++ b/pkgs/racket-test/tests/racket/contract/random-generate.rkt
@@ -413,11 +413,34 @@
   (check-exercise 2 void? even-list/c)
   (check-exercise 2 void? even-list/c/generate))
 
-(check-false
- (contract-random-generate
-  (make-chaperone-contract
-   #:late-neg-projection
-   (λ (b) (λ (f v np) v)))))
+(let () ;; test the default value of generate / exercise for make-chaperone-contract
+  (define custom-any/c
+    (make-chaperone-contract
+     #:late-neg-projection
+     (λ (b) (λ (v np) v))))
+  (define any->any/c
+    (make-chaperone-contract
+     #:late-neg-projection
+     (λ (b)
+       (λ (v np)
+         (chaperone-procedure v values impersonator-prop:contracted any->any/c)))))
+  (define/contract proc any->any/c values)
+  (check-exn cannot-generate-exn? (λ () (test-contract-generation custom-any/c)))
+  (check-not-exn (λ () (contract-exercise proc))))
+
+(let ()
+  (struct impersonate-any/c-struct ()
+    #:property prop:contract
+    (build-contract-property
+     #:late-neg-projection
+     (λ (ctc) (λ (b) (λ (v np) v)))))
+  (define impersonate-any/c (impersonate-any/c-struct))
+  (check-exn cannot-generate-exn? (λ () (test-contract-generation impersonate-any/c)))
+  (check-exn cannot-generate-exn?
+             (λ ()
+               (test-contract-generation
+                (->i ([n integer?])
+                     [_ (n) (λ (r) (eq? r (even? n)))])))))
 
 (check-exercise
  10
diff --git a/racket/collects/racket/contract/private/prop.rkt b/racket/collects/racket/contract/private/prop.rkt
index 1305d087dd..9a3c103260 100644
--- a/racket/collects/racket/contract/private/prop.rkt
+++ b/racket/collects/racket/contract/private/prop.rkt
@@ -298,7 +298,7 @@
          #:late-neg-projection [get-late-neg-projection #f]
          #:stronger [stronger #f]
          #:equivalent [equivalent #f]
-         #:generate [generate (λ (ctc) (λ () #f))]
+         #:generate [generate (λ (ctc) (λ (fuel) #f))]
          #:exercise [exercise (λ (ctc) (λ (fuel) (values void '())))]
          #:list-contract? [list-contract? (λ (c) #f)])
   (unless (or get-first-order
@@ -476,8 +476,8 @@
          #:late-neg-projection [late-neg-projection #f]
          #:stronger [stronger #f]
          #:equivalent [equivalent #f]
-         #:generate [generate (λ (ctc) (λ () #f))]
-         #:exercise [exercise (λ (ctc) (λ (fuel) (values void '())))]
+         #:generate [generate (λ (fuel) #f)]
+         #:exercise [exercise (λ (fuel) (values void '()))]
          #:list-contract? [list-contract? #f])
 
   (unless (or first-order