(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)))
     ))
  )