From e25575b16a13eba15fa96741ee0b8b311a705db5 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Sat, 3 Jan 2015 17:16:15 -0600
Subject: [PATCH] improve contract random generation for null? and
 recursive-contract

---
 .../tests/racket/contract-rand-test.rkt         | 11 +++++++++++
 .../collects/racket/contract/private/base.rkt   | 17 +++++++++++++++--
 .../collects/racket/contract/private/guts.rkt   |  1 +
 3 files changed, 27 insertions(+), 2 deletions(-)

diff --git a/pkgs/racket-test/tests/racket/contract-rand-test.rkt b/pkgs/racket-test/tests/racket/contract-rand-test.rkt
index 1132ec2738..3c58dc312b 100644
--- a/pkgs/racket-test/tests/racket/contract-rand-test.rkt
+++ b/pkgs/racket-test/tests/racket/contract-rand-test.rkt
@@ -74,6 +74,17 @@
      (or/c (cons/c any/c (cons/c any/c even-length-list/c))
            '())))))
 
+(check-not-exn
+ (λ ()
+   (test-contract-generation
+    null?)))
+
+(check-not-exn
+ (λ ()
+   (test-contract-generation
+    (letrec ([c (or/c null? (cons/c real? (recursive-contract c)))])
+      c))))
+
 (check-not-exn
  (λ ()
    (struct s (a b) #:transparent)
diff --git a/racket/collects/racket/contract/private/base.rkt b/racket/collects/racket/contract/private/base.rkt
index 5a36858ffd..c7bb61c493 100644
--- a/racket/collects/racket/contract/private/base.rkt
+++ b/racket/collects/racket/contract/private/base.rkt
@@ -13,7 +13,9 @@
          "blame.rkt"
          "prop.rkt"
          "arrow.rkt"
-         "misc.rkt")
+         "misc.rkt"
+         "generate.rkt"
+         )
 
 (define-for-syntax lifted-ccrs (make-hasheq))
 
@@ -182,7 +184,15 @@
   (contract-first-order-passes? (force-recursive-contract ctc)
                                 val))
 
-(struct recursive-contract ([name #:mutable] thunk [ctc #:mutable] list-contract?)
+(define (recursive-contract-generate ctc)
+  (λ (fuel)
+    (cond
+      [(zero? fuel) #f]
+      [else
+       (force-recursive-contract ctc)
+       (contract-random-generate/choose (recursive-contract-ctc ctc) (- fuel 1))])))
+
+(struct recursive-contract ([name #:mutable] [thunk #:mutable] [ctc #:mutable] list-contract?)
   #:property prop:recursive-contract (λ (this)
                                        (force-recursive-contract this)
                                        (recursive-contract-ctc this)))
@@ -195,6 +205,7 @@
    #:first-order recursive-contract-first-order
    #:projection recursive-contract-projection
    #:stronger recursive-contract-stronger
+   #:generate recursive-contract-generate
    #:list-contract? recursive-contract-list-contract?))
 (struct chaperone-recursive-contract recursive-contract ()
   #:property prop:custom-write custom-write-property-proc
@@ -204,6 +215,7 @@
    #:first-order recursive-contract-first-order
    #:projection recursive-contract-projection
    #:stronger recursive-contract-stronger
+   #:generate recursive-contract-generate
    #:list-contract? recursive-contract-list-contract?))
 (struct impersonator-recursive-contract recursive-contract ()
   #:property prop:custom-write custom-write-property-proc
@@ -213,4 +225,5 @@
    #:first-order recursive-contract-first-order
    #:projection recursive-contract-projection
    #:stronger recursive-contract-stronger
+   #:generate recursive-contract-generate
    #:list-contract? recursive-contract-list-contract?))
diff --git a/racket/collects/racket/contract/private/guts.rkt b/racket/collects/racket/contract/private/guts.rkt
index b59d57cb2a..0e310c3c77 100644
--- a/racket/collects/racket/contract/private/guts.rkt
+++ b/racket/collects/racket/contract/private/guts.rkt
@@ -232,6 +232,7 @@
       [(contract-struct? x) #f] ;; this has to come first, since some of these are procedure?.
       [(and (procedure? x) (procedure-arity-includes? x 1))
        (cond
+         [(eq? x null?) list/c-empty]
          [(and (eq? x list?) listof-any) listof-any]
          [(and (eq? x pair?) consc-anyany) consc-anyany]
          [else