diff options
| author | 2025-02-14 17:04:53 -0500 | |
|---|---|---|
| committer | 2025-02-14 17:04:53 -0500 | |
| commit | 23cf3e36242b6d23e2b2ee8c7947a22e04770f56 (patch) | |
| tree | 016333e0fb0e1f4066f9ae3dac1b640cc7257149 /srfi-252.sld | |
| parent | tests run in CHICKEN 5 (diff) | |
separate generators into different library
Diffstat (limited to '')
| -rw-r--r-- | srfi-252.sld | 211 |
1 files changed, 4 insertions, 207 deletions
diff --git a/srfi-252.sld b/srfi-252.sld index 1c630e6..b4227c1 100644 --- a/srfi-252.sld +++ b/srfi-252.sld @@ -25,13 +25,10 @@ (define-library (srfi 252) (import (scheme base) (scheme case-lambda) - (scheme complex) (srfi 1) - (srfi 64) (chicken condition) - (srfi 158) - (srfi 194) - (srfi 143) - (srfi 144)) + (srfi 64) + (srfi 252 generators) + (chicken condition)) (export test-property test-property-expect-fail test-property-skip test-property-error test-property-error-type property-test-runner @@ -55,210 +52,10 @@ list-generator-of pair-generator-of procedure-generator-of vector-generator-of) (begin - ;; Constants - ;; These values may be implementation-dependent, but should be reasonably - ;; high numbers. ;; Number of property tests to run by default. (define default-runs 100) - ;; Value range for exact random generators. - (define max-exact fx-greatest) - (define min-exact fx-least) - ;; Value range for inexact random generators. - (define max-inexact fl-greatest) - (define min-inexact fl-least) - ;; Maximum size for random bytevector/list/string/symbol/vector generators. - (define max-size 1001) - ;; Maximum character supported by integer->char. - (define max-char #x10FFFF) - ;; Omit values that are not distinguished in the implementation. - (define special-number - (append - ;; Exact integers - '(0 1 -1) - ;; Exact ratios - '(1/2 -1/2) - ;; Exact complex - '(0+i 0-i 1+i 1-i -1+i -1-i) - ;; Exact complex ratios - '(1/2+1/2i 1/2-1/2i -1/2+1/2i -1/2-1/2i) - ;; Inexact (integers and non-integers) - '(0.0 -0.0 0.5 -0.5 1.0 -1.0) - ;; Inexact-complex - '(0.0+1.0i 0.0-1.0i -0.0+1.0i -0.0-1.0i - 0.5+0.5i 0.5-0.5i -0.5+0.5i -0.5-0.5i - 1.0+1.0i 1.0-1.0i -1.0+1.0i -1.0-1.0i - +inf.0+inf.0i +inf.0-inf.0i -inf.0+inf.0i -inf.0-inf.0i - +nan.0+nan.0i) - ;; Other (-nan.0 not required, synonymous with +nan.0) - '(+inf.0 -inf.0 +nan.0))) - (define (special-number-generator) - (list->generator special-number)) - ;; Generator procedures - (define (boolean-generator) - (gcons* #t #f (make-random-boolean-generator))) - (define (bytevector-generator) - (let ((gen (make-random-u8-generator))) - (gcons* (bytevector) - (gmap (lambda (len) - (apply bytevector (generator->list gen len))) - (make-random-integer-generator 0 max-size))))) - (define (char-generator) - (gcons* #\null - (gmap integer->char - (gfilter (lambda (x) - (or (< x #xD800) (> x #xDFFF))) - (make-random-integer-generator 0 max-char))))) - (define (string-generator) - (gcons* "" - (gmap (lambda (n) - (generator->string (gdrop (char-generator) 1) n)) - (make-random-integer-generator 1 max-size)))) - (define (symbol-generator) - (gmap string->symbol (string-generator))) - ;; Exact number generators - (define (exact-complex-generator) - (gappend (gfilter (lambda (x) - (and (complex? x) - (exact? (real-part x)) - (exact? (imag-part x)))) - (special-number-generator)) - (gmap make-rectangular - (exact-real-generator) - (exact-real-generator)))) - (define (exact-integer-generator) - (gappend (gfilter (lambda (x) - (and (exact? x) (integer? x))) - (special-number-generator)) - (make-random-integer-generator min-exact max-exact))) - (define (ratio-gen) - (gmap / - (make-random-integer-generator min-exact max-exact) - (gfilter (lambda (x) (not (zero? x))) - (make-random-integer-generator min-exact max-exact)))) - (define (exact-number-generator) - ;; Ensure there are no repeated special values, and a random sampling - ;; between exact ratios, complex, and integers. - (gappend - (gfilter exact? (special-number-generator)) - (gsampling (gmap make-rectangular - (exact-real-generator) (exact-real-generator)) - (ratio-gen) - (make-random-integer-generator min-exact max-exact)))) - (define (exact-rational-generator) - (gappend - (gfilter (lambda (x) - (and (rational? x) (exact? x))) - (special-number-generator)) - (gsampling (ratio-gen) - (make-random-integer-generator min-exact max-exact)))) - (define (exact-real-generator) - (gappend - (gfilter (lambda (x) - (and (real? x) (exact? x))) - (special-number-generator)) - (gsampling (ratio-gen) - (make-random-integer-generator min-exact max-exact)))) - (define (exact-integer-complex-generator) - (gappend (gfilter (lambda (x) - (and (complex? x) - (exact? (real-part x)) - (exact? (imag-part x)) - (integer? (real-part x)) - (integer? (imag-part x)))) - (special-number-generator)) - (gmap make-rectangular - (make-random-integer-generator min-exact max-exact) - (make-random-integer-generator min-exact max-exact)))) - ;; Inexact number generators - (define (inexact-complex-generator) - (gappend (gfilter (lambda (x) - (and (complex? x) - (inexact? (real-part x)) - (inexact? (imag-part x)))) - (special-number-generator)) - (make-random-rectangular-generator min-inexact max-inexact - min-inexact max-inexact))) - (define (inexact-integer-generator) - (gmap inexact (exact-integer-generator))) - (define (inexact-number-generator) - (gappend (gfilter inexact? (special-number-generator)) - (gsampling (make-random-rectangular-generator - min-inexact max-inexact min-inexact max-inexact) - (make-random-real-generator min-inexact max-inexact)))) - (define (inexact-rational-generator) - (gappend (gfilter (lambda (x) - (and (rational? x) - (inexact? x))) - (special-number-generator)) - (make-random-real-generator min-inexact max-inexact))) - (define (inexact-real-generator) - (gappend (gfilter (lambda (x) - (and (real? x) - (inexact? x))) - (special-number-generator)) - (make-random-real-generator min-inexact max-inexact))) - ;; Unions of number generators - (define (complex-generator) - (gsampling (exact-complex-generator) - (inexact-complex-generator))) - (define (integer-generator) - (gsampling (exact-integer-generator) - (inexact-integer-generator))) - (define (number-generator) - ;; TODO: May need to be modified for unusual implementation-specific - ;; number types, like Kawa's quaternion. - (gsampling (exact-number-generator) - (inexact-number-generator))) - (define (rational-generator) - (gsampling (exact-rational-generator) - (inexact-rational-generator))) - (define (real-generator) - (gsampling (exact-real-generator) - (inexact-real-generator))) - ;; Special generators for collection types - (define list-generator-of - (case-lambda - ((gen) - (gcons* '() - (gmap (lambda (len) - (generator->list gen len)) - (make-random-integer-generator 1 max-size)))) - ((gen max-length) - (gcons* '() - (gmap (lambda (len) - (generator->list gen len)) - (make-random-integer-generator 1 max-length)))))) - (define pair-generator-of - (case-lambda - ((gen1) (gmap cons gen1 gen1)) - ((gen1 gen2) (gmap cons gen2 gen2)))) - (define (procedure-generator-of gen) - ;; Generate variadic procedures that returns a value from a generator. - ;; Useful for testing procedures that accept procedure arguments. - (gmap (lambda (x) - (lambda _ - x)) - gen)) - (define vector-generator-of - (case-lambda - ((gen) - (gcons* (vector) - (gmap (lambda (len) - (generator->vector gen len)) - (make-random-integer-generator 0 max-size)))) - ((gen max-length) - (gcons* (vector) - (gmap (lambda (len) - (generator->vector gen len)) - (make-random-integer-generator 0 max-length)))))) ;; Runner - (define (property-test-runner) - ;; Implementation specific. - ;; Some implementations do not support extended test runners. - (let ((runner (test-runner-simple))) - ;; (test-runner-on-test-end! runner property-test-runner-on-test-end) - ;; (test-runner-on-group-end! runner property-test-runner-on-group-end) - runner)) + (define property-test-runner test-runner-create) ;; Test procedures (define (prop-test property generators runs) (for-each |
