suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fail random generation of range contracts with bad bounds

Browse Source
This commit is contained in:
Cameron Moy 2021-02-24 20:06:52 -05:00 committed by Robby Findler
parent f1fb22f0a7
commit 7f34da35e7
4 changed files with 11 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
pkgs/racket-test/tests/racket/contract/random-generate.rkt
View File

@ -245,7 +245,9 @@
(exn-message x)))) (exn-message x))))
(check-exn cannot-generate-exn? (λ () (test-contract-generation some-crazy-predicate?))) (check-exn cannot-generate-exn? (λ () (test-contract-generation some-crazy-predicate?)))
(check-exn cannot-generate-exn? (λ () (test-contract-generation (list/c some-crazy-predicate?)))) (check-exn cannot-generate-exn? (λ () (test-contract-generation (list/c some-crazy-predicate?))))
(check-exn cannot-generate-exn? (λ () (test-contract-generation (between/c 10 0))))
(check-exn cannot-generate-exn? (λ () (test-contract-generation (integer-in 10 0))))
(check-exn cannot-generate-exn? (λ () (test-contract-generation (char-in #\z #\a))))
(check-not-exn (lambda () (test-contract-generation (or/c #f number?)))) (check-not-exn (lambda () (test-contract-generation (or/c #f number?))))
(check-not-exn (lambda () (test-contract-generation (first-or/c #f number?)))) (check-not-exn (lambda () (test-contract-generation (first-or/c #f number?))))

4
racket/collects/racket/contract/private/and.rkt
View File

@ -348,9 +348,11 @@
[(or start end) [(or start end)
(define _start (or start (- end max-random-range))) (define _start (or start (- end max-random-range)))
(define _end (or end (+ start max-random-range))) (define _end (or end (+ start max-random-range)))
(define upper-bound (min 4294967087 (+ (- _end _start) 1)))
(λ (fuel) (λ (fuel)
(and (>= upper-bound 1)
(λ () (λ ()
(+ _start (random (min 4294967087 (+ (- _end _start) 1))))))] (+ _start (random upper-bound)))))]
[else [else
(λ (fuel) (λ (fuel)
(λ () (λ ()

3
racket/collects/racket/contract/private/guts.rkt
View File

@ -723,8 +723,9 @@
(define high (char->integer (char-in/c-high ctc))) (define high (char->integer (char-in/c-high ctc)))
(define delta (+ (- high low) 1)) (define delta (+ (- high low) 1))
(λ (fuel) (λ (fuel)
(and (>= delta 1)
(λ () (λ ()
(integer->char (+ low (random delta)))))))) (integer->char (+ low (random delta)))))))))
(define (regexp/c-equivalent this that) (define (regexp/c-equivalent this that)
(and (regexp/c? that) (and (regexp/c? that)

1
racket/collects/racket/contract/private/misc.rkt
View File

@ -127,6 +127,7 @@
(* 1.0 choice) (* 1.0 choice)
choice))] choice))]
[else choice]))] [else choice]))]
[(> n m) #f]
[else [else
(λ () (λ ()
(rand-choice (rand-choice