#lang scheme/base
  
(require (planet schematics/schemeunit:3))
(require (lib "etc.ss")
         "benchmark.ss"
         "benchmark-log.ss")
  
(provide benchmark-tests)

;; Slow definition we use to generate measurable times
(define (factorial n)
  (if (zero? n)
      1
      (* n (factorial (sub1 n)))))

(define fast (lambda () 499500))
(define slow (lambda () (factorial 2048)))

(define fast-times (benchmark-time* fast))
(define slow-times (benchmark-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"

   (test-case
    "benchmark-time gives sensible results"
    (let ([t (benchmark-time (slow))])
      (check-pred vector? t)
      (for ([time (in-vector t)])
           (check-pred integer? time)
           (check-true (> time 0)))))

   (test-case
    "faster*?"
    (check-true (faster*? "fast" #(1 2 1 3 1 2 1 2 1 4)
                          "slow" #(2 3 4 5 3 4 2 4 5 2)
                          #f))
    (check-false (faster*? "slow" #(2 3 4 5 3 4 2 4 5 2)
                           "fast" #(1 2 1 3 1 2 1 2 1 4)
                           #f)))

   (test-case
    "faster*? returns false for equal thunks"
    (check-false
     (faster*? "fast1" fast-times "fast2" fast-times #f)))
   
   (test-case
    "as-fast*?"
    (check-true (as-fast*? "fast" #(2 1 3 1 2 1 4 1 1 2)
                           "fast" #(1 2 1 3 1 2 1 2 1 4)
                           #f))
    (check-false (as-fast*? "slow" #(2 3 4 5 3 4 2 4 5 2)
                            "fast" #(1 2 1 3 1 2 1 2 1 4)
                            #f)))

   (test-case
    "faster?"
    (check-true (faster? ["fast" (fast)]
                         ["slow" (slow)]))
    (check-false (faster? ["slow" (slow)]
                          ["fast" (fast)])))

   (test-case
    "as-fast?"
    (check-true (as-fast? ["fast" (fast)]
                          ["slow" (fast)]))
    (check-false (as-fast? ["slow" (slow)]
                           ["fast" (fast)])))
   
   (test-case
    "check-faster fails when given slower thunk"
    (let ([result
           (run-test (delay-test
                      (test-case "Dummy" (check-faster "slow" slow "fast" fast))))])
      (check = (length result) 1)
      (check-pred test-failure? (car result))))

   (test-case
    "check-faster succeeds when given faster thunk"
    (let ([result
           (run-test (delay-test
                      (test-case "Dummy" (check-faster "fast" fast "slow" slow))))])
      (check = (length result) 1)
      (check-pred test-success? (car result))))

   (test-case
    "check-as-fast fails when given slower thunk"
    (let ([result
           (run-test (delay-test
                      (test-case "Dummy" (check-as-fast "slow" slow "fast" fast))))])
      (check = (length result) 1)
      (check-pred test-failure? (car result))))

   (test-case
    "check-as-fast succeeds when given equal thunks"
    (let ([result
           (run-test (delay-test
                      (test-case "Dummy" (check-as-fast "fast" fast "fast" fast))))])
      (check = (length result) 1)
      (check-pred test-success? (car result))))
   
   (test-case
    "check-faster-times succeeds when given faster times"
    (let ([result
           (run-test (delay-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 (delay-test
                      (test-case "Dummy"
                                 (check-faster-times slow-times fast-times))))])
      (check = (length result) 1)
      (check-pred test-failure? (car result))))

   (benchmark-case
    "benchmark-case run as usual tests when nothing is timed"
    (check = 1 1))
   
   (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)))
   ))