peter/srfi-252-egg
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

tests run in CHICKEN 5

Browse source
This commit is contained in:
Peter McGoron 2025-01-10 18:01:05 -05:00
commit ae54a031c9
6 changed files with 13190 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
.gitignore vendored Normal file
View file

@ -0,0 +1,6 @@
*.build.sh
*.install.sh
*.import.scm
*.so
*.link
*.o

1
README.md Normal file
View file

@ -0,0 +1 @@
# SRFI 252 for CHICKEN

11
srfi-252.egg Normal file
View file

@ -0,0 +1,11 @@
((author "Antero Mejr")
(maintainer "Peter McGoron")
(version "0.9.0")
(synopsis "Property Testing")
(category "test")
(license "MIT")
(dependencies "r7rs" "srfi-1" "srfi-64" "srfi-158" "srfi-194" "srfi-143" "srfi-144")
(test-dependencies "srfi-1" "srfi-27" "srfi-64" "srfi-158" "srfi-194")
(components (extension srfi-252
(source "srfi-252.sld")
(csc-options "-R" "r7rs" "-X" "r7rs"))))

322
srfi-252.sld Normal file
View file

@ -0,0 +1,322 @@
;; Property-based testing extension for SRFI 64.
;; SPDX-License-Identifier: MIT
;; Copyright 2024 Antero Mejr <mail@antr.me>
;; Permission is hereby granted, free of charge, to any person
;; obtaining a copy of this software and associated documentation
;; files (the "Software"), to deal in the Software without
;; restriction, including without limitation the rights to use, copy,
;; modify, merge, publish, distribute, sublicense, and/or sell copies
;; of the Software, and to permit persons to whom the Software is
;; furnished to do so, subject to the following conditions:
;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;; SOFTWARE.
(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))
(export test-property test-property-expect-fail test-property-skip
test-property-error test-property-error-type
property-test-runner
;; Generator procedures
boolean-generator bytevector-generator
char-generator string-generator symbol-generator
;; exact number generators
exact-complex-generator exact-integer-generator
exact-number-generator exact-rational-generator
exact-real-generator
exact-integer-complex-generator
;; inexact number generators
inexact-complex-generator inexact-integer-generator
inexact-number-generator inexact-rational-generator
inexact-real-generator
;; Unions of numerical generators
complex-generator integer-generator
number-generator rational-generator
real-generator
;; Special generators
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))
;; Test procedures
(define (prop-test property generators runs)
(for-each
(lambda (n)
(test-assert
(apply property
(let ((args (map (lambda (gen) (gen)) generators))
(runner (test-runner-current)))
(test-result-set! runner 'property-test-arguments args)
(test-result-set! runner 'property-test-iteration
(+ n 1))
(test-result-set! runner 'property-test-iterations runs)
args))))
(iota runs)))
(define (prop-test-error type property generators runs)
(for-each
(lambda (n)
(test-error
type
(apply property
(let ((args (map (lambda (gen) (gen)) generators))
(runner (test-runner-current)))
(test-result-set! runner 'property-test-arguments args)
(test-result-set! runner 'property-test-iteration (+ n 1))
(test-result-set! runner 'property-test-iterations runs)
args))))
(iota runs)))
(define test-property-error
(case-lambda
((property generators)
(prop-test-error #t property generators default-runs))
((property generators n)
(prop-test-error #t property generators n))))
(define test-property-error-type
(case-lambda
((type property generators)
(prop-test-error type property generators default-runs))
((type property generators n)
(prop-test-error type property generators n))))
(define test-property-skip
(case-lambda
((property generators)
(begin (test-skip default-runs)
(prop-test property generators default-runs)))
((property generators n)
(begin (test-skip n)
(prop-test property generators n)))))
(define test-property-expect-fail
(case-lambda
((property generators)
(begin (test-expect-fail default-runs)
(prop-test property generators default-runs)))
((property generators n)
(begin (test-expect-fail n)
(prop-test property generators n)))))
(define test-property
(case-lambda
((property generators)
(prop-test property generators default-runs))
((property generators n)
(prop-test property generators n))))))

12628
tests/property-test.log Normal file
View file

File diff suppressed because it is too large Load diff

222
tests/run.scm Normal file
View file

@ -0,0 +1,222 @@
;; Tests for property-test library.
;; SPDX-License-Identifier: MIT
;; Copyright 2024 Antero Mejr <mail@antr.me>
;; Permission is hereby granted, free of charge, to any person
;; obtaining a copy of this software and associated documentation
;; files (the "Software"), to deal in the Software without
;; restriction, including without limitation the rights to use, copy,
;; modify, merge, publish, distribute, sublicense, and/or sell copies
;; of the Software, and to permit persons to whom the Software is
;; furnished to do so, subject to the following conditions:
;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;; SOFTWARE.
(import (scheme base)
(scheme complex)
(scheme read)
(srfi 1)
(srfi 27)
(srfi 64)
(srfi 158)
(srfi 194)
(srfi 252))
(test-begin "property-test")
(define (three x) 3)
(define (wrong-three x) x)
(define (three-property x) (= (three x) 3))
(define (wrong-three-property x) (= (wrong-three x) 3))
(define (error-three-property x) (string-append 1 2))
(define (make-read-error x) (read (open-input-string (string-append ")" x))))
(define (make-read-error-property x) (symbol? (make-read-error x)))
(define (bad-generator) (gmap (lambda (x)
(string-append 1 2)
x)
(boolean-generator)))
(test-group "test-property"
(test-property three-property (list (integer-generator)))
(test-property three-property (list (real-generator)))
(test-property three-property (list (integer-generator)) 10))
(test-group "test-property-expect-fail"
(test-property-expect-fail wrong-three-property (list (integer-generator)))
(test-property-expect-fail wrong-three-property (list (integer-generator)) 10))
(test-group "test-property-skip" ; shouldn't run
(test-property-skip three-property (list (bad-generator)))
(test-property-skip three-property (list (bad-generator)) 10))
(test-group "test-property-error"
(test-property-error error-three-property (list (integer-generator)))
(test-property-error error-three-property (list (integer-generator)) 10))
#;(cond-expand
((library (srfi 36))
(test-group "test-property-error-type"
(test-property-error-type &read-error make-read-error-property
(list (string-generator)))))
(else))
(test-group "test-property/with-2-arguments"
(test-property (lambda (x y)
(and (boolean? x) (integer? y)))
(list (boolean-generator) (integer-generator))))
;; Testing basic generators
(test-group "boolean-generator"
(test-property boolean? (list (boolean-generator))))
(test-group "bytevector-generator"
(test-property bytevector? (list (bytevector-generator))))
(test-group "char-generator"
(test-property char? (list (char-generator))))
(test-group "string-generator"
(test-property string? (list (string-generator))))
(test-group "symbol-generator"
(test-property symbol? (list (symbol-generator))))
;; Testing exact generators
(cond-expand
(exact-complex
(test-group "exact-complex-generator"
(test-property (lambda (x)
(and (complex? x)
(exact? (real-part x))
(exact? (imag-part x))))
(list (exact-complex-generator)))))
(else))
(test-group "exact-integer-generator"
(test-property (lambda (x)
(and (integer? x) (exact? x)))
(list (exact-integer-generator))))
(test-group "exact-number-generator"
(test-property exact? (list (exact-number-generator))))
(test-group "exact-rational-generator"
(test-property (lambda (x)
(and (exact? x) (rational? x)))
(list (exact-rational-generator))))
(test-group "exact-real-generator"
(test-property (lambda (x)
(and (exact? x) (real? x)))
(list (exact-real-generator))))
(test-group "exact-integer-complex-generator"
(cond-expand
(exact-complex
(test-property (lambda (x)
(and (complex? x)
(exact? (real-part x))
(exact? (imag-part x))
(integer? (real-part x))
(integer? (imag-part x))))
(list (exact-integer-complex-generator))))
(else)))
;; Testing inexact generators
(test-group "inexact-complex-generator"
(test-property (lambda (x)
(and (complex? x)
(inexact? (real-part x))
(inexact? (imag-part x))))
(list (inexact-complex-generator))))
(test-group "inexact-integer-generator"
(test-property (lambda (x)
(and (inexact? x) (integer? x)))
(list (inexact-integer-generator))))
(test-group "inexact-number-generator"
(test-property inexact? (list (inexact-number-generator))))
(test-group "inexact-rational-generator"
(test-property (lambda (x)
(and (inexact? x) (rational? x)))
(list (inexact-rational-generator))))
(test-group "inexact-integer-generator"
(test-property (lambda (x)
(and (inexact? x) (real? x)))
(list (inexact-real-generator))))
;; Testing union generators
(test-group "complex-generator"
(test-property complex? (list (complex-generator))))
(test-group "integer-generator"
(test-property integer? (list (integer-generator))))
(test-group "number-generator"
(test-property number? (list (number-generator))))
(test-group "rational-generator"
(test-property rational? (list (rational-generator))))
(test-group "real-generator"
(test-property real? (list (real-generator))))
;; Testing special generators
(test-group "list-generator-of"
(test-property (lambda (x)
(and (list? x) (<= (length x) 1001)
(every integer? x)))
(list (list-generator-of (integer-generator)))))
(test-group "pair-generator-of"
(test-property (lambda (x)
(pair? x) (integer? (car x)) (boolean? (cdr x)))
(list (pair-generator-of (integer-generator)
(boolean-generator)))))
(test-group "procedure-generator-of"
(test-property (lambda (x)
(procedure? x) (integer? (x)))
(list (procedure-generator-of (integer-generator)))))
(test-group "vector-generator-of"
(test-property (lambda (x)
(vector? x)
(<= (vector-length x) 1001)
(every integer? (vector->list x)))
(list (vector-generator-of (integer-generator)))))
(test-group "non-determinism"
(let ((gen1 (gdrop (exact-number-generator) 30)) ;skip the initial sequence
(gen2 (gdrop (exact-number-generator) 30)))
(test-property (lambda (x y)
(not (= x y)))
(list gen1 gen2))))
(test-group "determinism"
(parameterize ((current-random-source (make-random-source)))
(let ((gen1 (gdrop (exact-number-generator) 30)))
(parameterize ((current-random-source (make-random-source)))
(let ((gen2 (gdrop (exact-number-generator) 30)))
(test-property = (list gen1 gen2)))))))
(test-end)