diff --git a/pkgs/racket-doc/scribblings/reference/contracts.scrbl b/pkgs/racket-doc/scribblings/reference/contracts.scrbl index 819ca256d4..ca0211b5ee 100644 --- a/pkgs/racket-doc/scribblings/reference/contracts.scrbl +++ b/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?]) diff --git a/racket/collects/racket/contract/private/generate.rkt b/racket/collects/racket/contract/private/generate.rkt index 19c5fbb55c..62fdccd9f0 100644 --- a/racket/collects/racket/contract/private/generate.rkt +++ b/racket/collects/racket/contract/private/generate.rkt @@ -21,17 +21,26 @@ multi-exercise fail-escape) -(define (contract-exercise #:fuel [fuel 10] v1 . vs) - (define vals +(define (contract-exercise #:fuel [fuel 10] #:shuffle? [shuffle? #f] + 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))) - (for ([x (in-range fuel)]) - (go vals))) + ((multi-exercise ctcs #:allow-shuffle? shuffle?) fuel))) + (cond + [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)) - (values (λ (orig-vals) - (let loop ([exers rev-exers] - [vals orig-vals]) - (cond - [(null? exers) (void)] - [(null? vals) (loop exers orig-vals)] - [else - (let/ec k - (parameterize ([fail-escape (λ () (k))]) - ((car exers) (car vals)))) - (loop (cdr exers) (cdr vals))]))) + (define rev-exers (vector->immutable-vector (list->vector (reverse exers)))) + (define (do-exercise orig-vals shuffle?) + (define vals (vector->immutable-vector (list->vector orig-vals))) + (define exercise-order + (cond + [shuffle? (shuffle (range (vector-length rev-exers)))] + [else (range (vector-length rev-exers))])) + (for ([index (in-list exercise-order)]) + (define exer (vector-ref rev-exers index)) + (define val (vector-ref vals (modulo index (vector-length vals)))) + (let/ec k + (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