aboutsummaryrefslogtreecommitdiffstats
path: root/srfi-252.sld
diff options
context:
space:
mode:
authorGravatar Peter McGoron 2025-02-14 17:04:53 -0500
committerGravatar Peter McGoron 2025-02-14 17:04:53 -0500
commit23cf3e36242b6d23e2b2ee8c7947a22e04770f56 (patch)
tree016333e0fb0e1f4066f9ae3dac1b640cc7257149 /srfi-252.sld
parenttests run in CHICKEN 5 (diff)
separate generators into different library
Diffstat (limited to '')
-rw-r--r--srfi-252.sld211
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