Randomly shuffle contracts in contract-exercise

pkgs/racket-doc/scribblings/reference/contracts.scrbl

@@ -3507,7 +3507,7 @@ parts of the contract system.
                                    [fuel 5 exact-nonnegative-integer?]
                                    [fail (or/c #f (-> any) (-> boolean? any)) #f])
          any/c]{
-Attempts to randomly generate a value which will match the contract. The fuel
+Attempts to randomly generate a value which will match the contract. The @racket[_fuel]
 argument limits how hard the generator tries to generate a value matching the
 contract and is a rough limit of the size of the resulting value.
 
@@ -3527,7 +3527,9 @@ ended up returning @racket[contract-random-generate-fail].
 
 }
 
-@defproc[(contract-exercise [val any/c] ...+) void?]{
+@defproc[(contract-exercise [#:fuel fuel exact-nonnegative-integer? 10]
+                            [#:shuffle? shuffle? any/c #f]
+                            [val any/c] ...+) void?]{
   Attempts to get the @racket[val]s to break their contracts (if any).
                   
   Uses @racket[value-contract] to determine if any of the @racket[val]s have a
@@ -3535,6 +3537,15 @@ ended up returning @racket[contract-random-generate-fail].
   to poke and prod at the value. For example, if the value is function, it will
   use the contract to tell it what arguments to supply to the value.
 
+  The argument @racket[_fuel] determines how hard @racket[contract-exercise]
+  tries to break the values. It controls both the number of exercise iterations
+  and the size of the intermediate values generated during the exercises.
+
+  The argument @racket[_shuffle?] controls whether @racket[contract-exercise]
+  randomizes the exercise order or not. If @racket[_shuffle?] is not @racket[#f],
+  @racket[contract-exercise] would shuffle the order of the contracts in each
+  exercise iteration.
+
  @examples[#:eval (contract-eval) #:once
            (define/contract (returns-false x)
              (-> integer? integer?)
@@ -3548,6 +3559,8 @@ ended up returning @racket[contract-random-generate-fail].
              (code:comment "we're supposed to return a boolean")
              (f 11))
            (eval:error (contract-exercise calls-its-argument-with-eleven))]
+
+ @history[#:changed "7.0.0.18" @elem{Added the @racket[shuffle?] optional argument.}]
 }
 
 @defproc[(contract-random-generate/choose [c contract?] [fuel exact-nonnegative-integer?])

racket/collects/racket/contract/private/generate.rkt

@@ -21,17 +21,26 @@
          multi-exercise
          fail-escape)
 
-(define (contract-exercise #:fuel [fuel 10] v1 . vs)
+(define (contract-exercise #:fuel [fuel 10] #:shuffle? [shuffle? #f]
-  (define vals 
+                           v1 . vs)
+  (define orig-vals
     (for/list ([val (in-list (cons v1 vs))]
                #:when (value-contract val))
       val))
+  (define vals
+    (cond [shuffle? (shuffle orig-vals)]
+          [else orig-vals]))
   (define ctcs (map value-contract vals))
   (define-values (go _) 
     (parameterize ([generate-env (contract-random-generate-env (make-hash))])
-      ((multi-exercise ctcs) fuel)))
+      ((multi-exercise ctcs #:allow-shuffle? shuffle?) fuel)))
-  (for ([x (in-range fuel)])
+  (cond
-    (go vals)))
+    [shuffle?
+     (for ([x (in-range fuel)])
+       (go vals #:shuffle? (> x 0)))]
+    [else
+     (for ([x (in-range fuel)])
+       (go vals))]))
 
 (define (contract-random-generate-get-current-environment)
   (define env (generate-env))
@@ -41,7 +50,7 @@
   env)
 
 ;; multi-exercise : (listof contract?) -> fuel -> (values (listof ctc) (-> (listof val[ctcs]) void)
-(define (multi-exercise orig-ctcs)
+(define (multi-exercise orig-ctcs #:allow-shuffle? [allow-shuffle? #f])
   (λ (fuel)
     (let loop ([ctcs orig-ctcs]
                [exers '()]
@@ -53,18 +62,24 @@
          (cond
            [(or (zero? max-iterations)
                 (equal? previously-available-ctcs available-ctcs))
-            (define rev-exers (reverse exers))
+            (define rev-exers (vector->immutable-vector (list->vector (reverse exers))))
-            (values (λ (orig-vals)
+            (define (do-exercise orig-vals shuffle?)
-                      (let loop ([exers rev-exers]
+              (define vals (vector->immutable-vector (list->vector orig-vals)))
-                                 [vals orig-vals])
+              (define exercise-order
-                        (cond
+                (cond
-                          [(null? exers) (void)]
+                  [shuffle? (shuffle (range (vector-length rev-exers)))]
-                          [(null? vals) (loop exers orig-vals)]
+                  [else (range (vector-length rev-exers))]))
-                          [else
+              (for ([index (in-list exercise-order)])
-                           (let/ec k
+                (define exer (vector-ref rev-exers index))
-                             (parameterize ([fail-escape (λ () (k))])
+                (define val  (vector-ref vals (modulo index (vector-length vals))))
-                               ((car exers) (car vals))))
+                (let/ec k
-                           (loop (cdr exers) (cdr vals))])))
+                  (parameterize ([fail-escape (λ () (k))])
+                    (exer val)))))
+            (define (exercise/shuffle orig-vals #:shuffle? [shuffle? #f])
+              (do-exercise orig-vals shuffle?))
+            (define (exercise orig-vals)
+              (do-exercise orig-vals #f))
+            (values (if allow-shuffle? exercise/shuffle exercise)
                     available-ctcs)]
            [else
             (loop orig-ctcs