(module test-all mzscheme (require "random.ss" "schemeunit.ss" (lib "list.ss") (only (lib "43.ss" "srfi") vector-for-each) (planet "test.ss" ("schematics" "schemeunit.plt" 2 8)) (planet "graphical-ui.ss" ("schematics" "schemeunit.plt" 2 8))) (require-for-syntax (planet "syntax-utils.ss" ("cce" "syntax-utils.plt" 1 1))) (define (check/repeat count thunk) (let continue ([index 1]) (when (<= index count) (with-check-info (['index index]) (thunk)) (continue (+ index 1))))) (define-syntax (test-generator stx) (syntax-case stx () [(t-g name (arg ...) count proc) (with-syntax ([name/choose (syntax-prefix "choose-" (syntax name))] [name/random (syntax-prefix "random-" (syntax name))]) (syntax/loc stx (let* ([c count] [p proc]) (test-suite (format "~s" '(name arg ...)) (test-case (symbol->string 'name/choose) (check/repeat c (lambda () (p (name/choose arg ...))))) (test-case (symbol->string 'name/random) (check/repeat c (lambda () (p (generate (name/random arg ...))))))))))])) (test/graphical-ui (test-suite "FastTest" (test-suite "random.ss" (test-suite "generator?" (test-case "constant" (check-false (generator? 'value))) (test-case "nonrandom" (check-true (generator? (nonrandom 'value)))) (test-case "random-symbol" (check-true (generator? (random-symbol))))) (test-suite "generate" (test-case "constant" (check-eq? (generate 'value) 'value)) (test-case "filter" (check-pred even? (generate (random-int-between 1 100) even? 10))) (test-case "failure" (check-exn exn:fail? (lambda () (generate (random-string) char?))))) (test-suite "default-generate-attempts" (test-case "initial value" (check-pred integer? (default-generate-attempts)) (check-pred positive? (default-generate-attempts)))) (test-suite "nonrandom" (test-case "symbol" (check-eq? (generate (nonrandom 'value)) 'value))) (test-suite "random-int-between" (test-generator int-between (1 10) 100 (lambda (v) (check-pred integer? v) (check >= v 1) (check <= v 100)))) (test-suite "random-size" (test-generator size () 100 (lambda (v) (check-pred integer? v) (check >= v 0))) (test-generator size (5 2) 100 (lambda (v) (check-pred integer? v) (check >= v 5)))) (test-suite "random-boolean" (test-generator boolean () 100 (lambda (v) (check-pred boolean? v))) (test-generator boolean (1) 100 check-true) (test-generator boolean (0) 100 check-false)) (test-suite "random-char" (test-generator char () 100 (lambda (v) (check-pred char? v))) (test-generator char ((random-int-between (char->integer #\A) (char->integer #\Z))) 100 (lambda (v) (check-pred char-upper-case? v)))) (test-suite "random-group-of" (test-generator group-of (list (random-symbol)) 100 (lambda (v) (check-pred list? v) (for-each (lambda (e) (check-pred symbol? e)) v))) (test-generator group-of (cons (random-boolean) (nonrandom 2)) 100 (lambda (v) (check-pred pair? v) (check-pred boolean? (car v)) (check-pred boolean? (cdr v))))) (test-suite "random-list-of" (test-generator list-of ((random-boolean)) 100 (lambda (v) (check-pred list? v) (for-each (lambda (e) (check-pred boolean? e)) v))) (test-generator list-of ((random-char) (nonrandom 4)) 100 (lambda (v) (check-pred list? v) (check = (length v) 4) (for-each (lambda (e) (check-pred char? e)) v)))) (test-suite "random-vector-of" (test-generator vector-of ((random-char)) 100 (lambda (v) (check-pred vector? v) (vector-for-each (lambda (i e) (check-pred char? e)) v))) (test-generator vector-of ((random-string) (nonrandom 5)) 100 (lambda (v) (check-pred vector? v) (check = (vector-length v) 5) (vector-for-each (lambda (i e) (check-pred string? e)) v)))) (test-suite "random-string" (test-generator string () 100 (lambda (v) (check-pred string? v))) (test-generator string ((random-char (random-int-between (char->integer #\A) (char->integer #\Z))) (nonrandom 6)) 100 (lambda (v) (check-pred string? v) (check-equal? v (string-upcase v))))) (test-suite "random-bytes" (test-generator bytes () 100 (lambda (v) (check-pred bytes? v))) (test-generator bytes (23 3) 100 (lambda (v) (check-equal? v (bytes 23 23 23))))) (test-suite "random-apply" (test-generator apply (cons (random-char) (random-string)) 100 (lambda (v) (check-pred pair? v) (check-pred char? (car v)) (check-pred string? (cdr v))))) (test-suite "random-list" (test-generator list ((random-boolean) (random-char) (random-string) (random-int-between 1 10)) 100 (lambda (v) (check-pred list? v) (check = (length v) 4) (check-pred boolean? (first v)) (check-pred char? (second v)) (check-pred string? (third v)) (check-pred integer? (fourth v))))) (test-suite "random-vector" (test-generator vector ((random-boolean) (random-char) (random-string) (random-int-between 1 10)) 100 (lambda (v) (check-pred vector? v) (check = (vector-length v) 4) (check-pred boolean? (vector-ref v 0)) (check-pred char? (vector-ref v 1)) (check-pred string? (vector-ref v 2)) (check-pred integer? (vector-ref v 3))))) (test-suite "random-symbol" (test-generator symbol () 100 (lambda (v) (check-pred symbol? v))) (test-generator symbol ((nonrandom "value")) 100 (lambda (v) (check-eq? v 'value)))) (test-suite "random-uniform" (test-generator uniform ('bat 'cat 'dog) 100 (lambda (v) (check memq v '(bat cat dog))))) (test-suite "random-weighted" (test-generator weighted (1 'bat 2 'cat 3 'dog) 100 (lambda (v) (check memq v '(bat cat dog))))) (test-suite "random-weighted*" (test-generator weighted* ('((1 . bat) (2 . cat) (3 . dog))) 100 (lambda (v) (check memq v '(bat cat dog))))) (test-suite "random-recursive" (let () (define-struct leaf () #f) (define-struct node (left right) #f) (define (tree? v) (or (leaf? v) (and (node? v) (tree? (node-left v)) (tree? (node-right v))))) (test-generator recursive (tree-gen [2 (nonrandom (make-leaf))] [1 (random-apply make-node tree-gen tree-gen)]) 100 (lambda (v) (check-pred tree? v))))) (test-suite "random-function" (test-generator function ((lambda (n) (random-list-of (random-boolean) (nonrandom n)))) 100 (lambda (v) (check-pred procedure? v) (let* ([v1 (v 5)] [v2 (v 2)] [v3 (v 5)] [v4 (v 3)] [v5 (v 5)]) (check-pred list? v1) (check-pred list? v2) (check-pred list? v3) (check-pred list? v4) (check-pred list? v5) (check = (length v1) 5) (check = (length v2) 2) (check = (length v3) 5) (check = (length v4) 3) (check = (length v5) 5) (check-equal? v1 v3) (check-equal? v1 v5))))) (test-suite "define-generator" (test-case "sexp" (let () (define-generator (random-sexp max-depth) [4 (random-symbol)] [(if (< max-depth 1) 0 1) (random-apply cons (random-sexp (- max-depth 1)) (random-sexp (- max-depth 1)))]) (define (sexp-of-max-depth? d v) (or (symbol? v) (and (>= d 1) (pair? v) (sexp-of-max-depth? (- d 1) (car v)) (sexp-of-max-depth? (- d 1) (cdr v))))) (check/repeat 100 (lambda () (check sexp-of-max-depth? 2 (generate (random-sexp 2)))))))) (test-suite "let*-random" (test-case "difference" (let*-random ((x (random-int-between 1 10)) (y (random-int-between 1 15) (> y x) 10)) (check-pred positive? (- y x))))) ) (test-suite "schemeunit.ss" (test-suite "test-randomly" (test-randomly "list-ref-produces-member" 100 ([elems (random-list-of (random-symbol) (random-int-between 1 100))] [index (random-int-between 0 99) (< index (length elems)) 1000]) (check memq (list-ref elems index) elems)))))) )