From 7472058fd9e5d9a5d92d0cd49e58d791e8a942d1 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Tue, 29 Jul 2014 09:37:05 -0500
Subject: [PATCH] fix contract random generation for -> when the range is 'any'

---
 .../tests/racket/contract-rand-test.rkt       |  4 ++++
 .../contract/private/arrow-val-first.rkt      | 21 +++++++++++--------
 2 files changed, 16 insertions(+), 9 deletions(-)

diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/contract-rand-test.rkt b/pkgs/racket-pkgs/racket-test/tests/racket/contract-rand-test.rkt
index 46ef34d95b..ec6450b880 100644
--- a/pkgs/racket-pkgs/racket-test/tests/racket/contract-rand-test.rkt
+++ b/pkgs/racket-pkgs/racket-test/tests/racket/contract-rand-test.rkt
@@ -84,6 +84,10 @@
 
 (check-exn exn:fail? (λ () ((test-contract-generation (-> char? integer?)) 0)))
 (check-not-exn (λ () ((test-contract-generation (-> integer? integer?)) 1)))
+(check-not-exn (λ () ((test-contract-generation (-> integer? any)) 1)))
+(check-not-exn (λ () ((test-contract-generation (-> integer? (-> integer? any))) 1)))
+(check-not-exn (λ () ((test-contract-generation (-> (-> integer? any) integer?))
+                      (λ (i) (values 1 2 3)))))
 (check-not-exn (λ () ((test-contract-generation (-> (-> integer? integer?) boolean?)) +)))
 (check-not-exn 
  (λ () ((test-contract-generation (-> some-crazy-predicate? some-crazy-predicate?)) 11)))
diff --git a/racket/collects/racket/contract/private/arrow-val-first.rkt b/racket/collects/racket/contract/private/arrow-val-first.rkt
index af901275d0..111f677db6 100644
--- a/racket/collects/racket/contract/private/arrow-val-first.rkt
+++ b/racket/collects/racket/contract/private/arrow-val-first.rkt
@@ -723,11 +723,13 @@
          (set! dom-exers (cons exer dom-exers))
          (set! addl-available (append ctcs addl-available)))
        (define rngs-gens 
-         (with-definitely-available-contracts
-          addl-available
-          (λ ()
-            (for/list ([c (in-list (base->-rngs ctc))])
-              (generate/choose c fuel)))))
+         (if (base->-rngs ctc)
+             (with-definitely-available-contracts
+              addl-available
+              (λ ()
+                (for/list ([c (in-list (base->-rngs ctc))])
+                  (generate/choose c fuel))))
+             '()))
        (cond
          [(for/and ([rng-gen (in-list rngs-gens)])
             rng-gen)
@@ -787,10 +789,11 @@
                  (for/list ([gen (in-list gens)])
                    (gen))))
               (λ results 
-                (for ([res-ctc (in-list rng-ctcs)]
-                      [result (in-list results)])
-                  (env-stash env res-ctc result)))))
-           (base->-rngs ctc))]
+                (when rng-ctcs
+                  (for ([res-ctc (in-list rng-ctcs)]
+                        [result (in-list results)])
+                    (env-stash env res-ctc result))))))
+           (or rng-ctcs '()))]
          [else
           (values void '())]))]
     [else