(module benchmark-test mzscheme (require (planet "test.ss" ("schematics" "schemeunit.plt" 2))) (require (planet "iteration.ss" ("schematics" "macro.plt" 1)) (lib "etc.ss") "benchmark.ss" "benchmark-log.ss") (provide benchmark-tests) (define fast (lambda () 499500)) (define slow (lambda () (for ([i 0 1000] [sum 0]) (+ 1.0 sum)))) (define fast-times (collect-and-time fast)) (define slow-times (collect-and-time slow)) (define benchmark-log (this-expression-benchmark-log-file)) (define (write-benchmark-log name times) (delete-benchmark-log) (add-run benchmark-log name times)) (define (delete-benchmark-log) (when (file-exists? benchmark-log) (delete-file benchmark-log))) (define benchmark-tests (test-suite "All tests for benchmark" (benchmark-case "benchmark-case run as usual tests when nothing is timed" (check = 1 1)) (test-case "faster? returns true for faster thunk" (check-true (faster? fast slow))) (test-case "faster? returns false for slower thunk" (check-false (faster? slow fast))) (test-case "faster? returns false for equal thunks" (check-false (faster? fast fast))) (test-case "check-faster fails when given slower thunk" (let ([result (run-test (test-case "Dummy" (check-faster slow fast)))]) (check = (length result) 1) (check-pred test-failure? (car result)))) (test-case "check-faster succeeds when given faster thunk" (let ([result (run-test (test-case "Dummy" (check-faster fast slow)))]) (check = (length result) 1) (check-pred test-success? (car result)))) (test-case "check-faster-times succeeds when given faster times" (let ([result (run-test (test-case "Dummy" (check-faster-times fast-times slow-times)))]) (check = (length result) 1) (check-pred test-success? (car result)))) (test-case "check-faster-times fails when given slower times" (let ([result (run-test (test-case "Dummy" (check-faster-times slow-times fast-times)))]) (check = (length result) 1) (check-pred test-failure? (car result)))) (test-equal? "Path to benchmark log file correct" (this-expression-benchmark-log-file) (build-path (this-expression-source-directory) (string-append (path->string (this-expression-file-name)) ".benchmark-log"))) (test-equal? "benchmark-test-case has correct log-file" (benchmark-test-case-log-file (benchmark-case "foo" #t)) (this-expression-benchmark-log-file)) (test-case "Benchmark test succeeds when no log file exists" (around (delete-benchmark-log) (let ([result (run-test (benchmark-case "Dummy" #t))]) (check = (length result) 1) (check-pred test-success? (car result))) (delete-benchmark-log))) (test-case "Benchmark test fails if test expression fails" (around (delete-benchmark-log) (let ([result (run-test (benchmark-case "Dummy" (check = 0 1)))]) (check = (length result) 1) (check-pred test-failure? (car result))) (delete-benchmark-log))) (test-case "Benchmark test succeeds if test is faster" (around (write-benchmark-log "Dummy" slow-times) (let ([result (run-test (benchmark-case "Dummy" (fast)))]) (check = (length result) 1) (check-pred test-success? (car result))) (delete-benchmark-log))) (test-case "Benchmark test fails if test is slower" (around (write-benchmark-log "Dummy" fast-times) (let ([result (run-test (benchmark-case "Dummy" (slow)))]) (check = (length result) 1) (check-pred test-failure? (car result))) (delete-benchmark-log))) (test-case "benchmark-case writes new times to log" (around (delete-benchmark-log) (run-test (benchmark-case "Dummy" (slow))) (let ([run (find-most-recent-run benchmark-log "Dummy")]) (check-not-false run) (check string=? (run-name run) "Dummy") (check-pred vector? (run-times run))) (delete-benchmark-log))) (test-case "benchmark-case doesn't write slower times to log" (around (write-benchmark-log "Dummy" fast-times) (run-test (benchmark-case "Dummy" (slow))) (let ([run (find-most-recent-run benchmark-log "Dummy")]) (check-equal? (run-times run) fast-times)) (delete-benchmark-log))) (test-case "benchmark-case writes faster times to log" (around (write-benchmark-log "Dummy" slow-times) (let ([result (run-test (benchmark-case "Dummy" (fast)))] [run (find-most-recent-run benchmark-log "Dummy")]) (check-pred test-success? (car result)) (check (lambda (t1 t2) (not (equal? t1 t2))) (run-times run) slow-times)) (delete-benchmark-log))) )) )