From 33b94e65584179b1e2f11ea27651ac776ae27782 Mon Sep 17 00:00:00 2001
From: shhyou <shu-hung.you@eecs.northwestern.edu>
Date: Fri, 3 Aug 2018 22:13:18 -0500
Subject: [PATCH] Exercise application result in -> contract

---
 .../tests/racket/contract/random-generate.rkt | 17 ++++++++++++++
 .../racket/contract/private/arr-i.rkt         | 22 +++++++++++++------
 .../contract/private/arrow-val-first.rkt      | 11 +++++++++-
 3 files changed, 42 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 bb8a70a519..ee8f98a6f7 100644
--- a/pkgs/racket-test/tests/racket/contract/random-generate.rkt
+++ b/pkgs/racket-test/tests/racket/contract/random-generate.rkt
@@ -418,3 +418,20 @@
   (make-chaperone-contract
    #:late-neg-projection
    (λ (b) (λ (f v np) v)))))
+
+(check-exercise
+ 10
+ pos-exn?
+ (contract (-> integer? (-> integer? integer?))
+           (λ (x) (λ (y) #f))
+           'pos
+           'neg))
+
+(check-exercise
+ 10
+ pos-exn?
+ (contract (->i ([m integer?])
+                [result (-> integer? integer?)])
+           (λ (x) (λ (y) #f))
+           'pos
+           'neg))
diff --git a/racket/collects/racket/contract/private/arr-i.rkt b/racket/collects/racket/contract/private/arr-i.rkt
index b18715d000..4638d3cf8b 100644
--- a/racket/collects/racket/contract/private/arr-i.rkt
+++ b/racket/collects/racket/contract/private/arr-i.rkt
@@ -130,6 +130,13 @@
                                    #:when (and (not (->i-arg-optional? arg-ctc))
                                                (->i-arg-kwd arg-ctc)))
                           (->i-arg-kwd arg-ctc)))
+       (define rng-ctcs (map cdr (->i-rng-ctcs ctc)))
+       (define rng-exers
+         (and rng-ctcs
+              (for/list ([rng-ctc (in-list rng-ctcs)])
+                (define-values (exer ctcs)
+                  ((contract-struct-exercise rng-ctc) fuel))
+                exer)))
        (cond
          [(andmap values gens)
           (define env (contract-random-generate-get-current-environment))
@@ -149,13 +156,14 @@
                         regular-args))
                      (λ results
                        (void)
-                       ;; what to do here? (nothing, for now)
-                       ;; better: if we did actually stash the results we knew about.
-                       '(for ([res-ctc (in-list rng-ctcs)]
-                              [result (in-list results)])
-                          (contract-random-generate-stash env res-ctc result)))))
-                  ;; better here: if we promised the results we knew we could deliver
-                  '())]
+                       (when rng-ctcs
+                         (for ([res-ctc (in-list rng-ctcs)]
+                               [result (in-list results)])
+                           (contract-random-generate-stash env res-ctc result))
+                         (for ([exer (in-list rng-exers)]
+                               [result (in-list results)])
+                           (exer result))))))
+                  (or rng-ctcs '()))]
          [else
           (values void '())]))]
     [else
diff --git a/racket/collects/racket/contract/private/arrow-val-first.rkt b/racket/collects/racket/contract/private/arrow-val-first.rkt
index 9428b938c6..6409a91292 100644
--- a/racket/collects/racket/contract/private/arrow-val-first.rkt
+++ b/racket/collects/racket/contract/private/arrow-val-first.rkt
@@ -1386,6 +1386,12 @@
        (define kwd-gens
          (for/list ([kwd-info (in-list dom-kwd-infos)])
            (contract-random-generate/choose (kwd-info-ctc kwd-info) fuel)))
+       (define rng-exers
+         (and rng-ctcs
+              (for/list ([rng-ctc (in-list rng-ctcs)])
+                (define-values (exer ctcs)
+                  ((contract-struct-exercise rng-ctc) fuel))
+                exer)))
        (define env (contract-random-generate-get-current-environment))
        (cond
          [(and (andmap values gens)
@@ -1405,7 +1411,10 @@
                 (when rng-ctcs
                   (for ([res-ctc (in-list rng-ctcs)]
                         [result (in-list results)])
-                    (contract-random-generate-stash env res-ctc result))))))
+                    (contract-random-generate-stash env res-ctc result))
+                  (for ([exer (in-list rng-exers)]
+                        [result (in-list results)])
+                    (exer result))))))
            (or rng-ctcs '()))]
          [else
           (values void '())]))]