;;;;

(import test)
(import (only (chicken format) format) (test-utils gloss))

(define glossed
  (let ((saved #f))
    (lambda (#!optional (x (void)))
      (if (eq? x (void))
        (gloss saved)
        (begin (set! saved x) x)))))

(define (wait-message #!optional secs)
  (gloss "Please Wait" (cond ((number? secs) secs) (secs) (else 'unknown)) '...))

;;

(cond-expand
  (compiling
    (gloss)
    (gloss "*************************")
    (gloss "*  Expect Type Warnings")
    (gloss "* (parameters wrong type)")
    (gloss "*************************") )
  (else))

(test-begin "micro-benchmark")

(import micro-benchmark (only micro-stats generate-statistics))
(include "micro-benchmark-test-utils")

;fp-utils
(import (chicken flonum))

(define (fpzero? n) (or (fp= 0.0 n) (fp= -0.0 n)))

(define (fpprecision-factor p #!optional (base 10.0)) (fpexpt base (exact->inexact p)))

;;

#; ;
(do ((n 0 (add1 n))) ((= 7 n))
  (do ((i 1 (add1 i))) ((= 10 i))
    (let ((r (* i (expt 10 n))))
      (print "bigO " r " " (bigO r)) ) ) )

(test-group "parameters wrong type"
  (test-error (current-benchmark-iterations 'skidoo))
  (test-error (current-benchmark-statistics-set 23))
)

(test-group "current-microseconds"
  (import current-microseconds)
  (glossf "(current-microseconds) = ~A" (current-microseconds))
  (test-assert (integer? (current-microseconds)))
  (let ((1secago (current-microseconds)))
    (sleep 1)
    (test-assert (< 1secago (current-microseconds))) )
)

;(so no conversion)
(define-constant PRECISION-DEFAULT 4.0)

(define-syntax make-unary-with-precision
  (syntax-rules ()
    ((make-unary-with-precision ?op)
      (lambda (n #!optional (p PRECISION-DEFAULT))
        (if (fpzero? (exact->inexact p))
          (?op n)
          (let ((pf (fpprecision-factor p)))
            (fp/ (?op (fp* n pf)) pf) ) ) ) ) ) )

;;

(define fptruncate-with-precision (make-unary-with-precision fptruncate))
(define fpround-with-precision (make-unary-with-precision fpround))
(define fpceiling-with-precision (make-unary-with-precision fpceiling))
(define fpfloor-with-precision (make-unary-with-precision fpfloor))

(define fptruncate/to fptruncate-with-precision)
(define fpround/to fpround-with-precision)
(define fpceiling/to fpceiling-with-precision)
(define fpfloor/to fpfloor-with-precision)

;;

(define-constant MS/SEC 1e6)
(define (ms->secs x) (/ x MS/SEC))

;NOTE (sleep i) seems to actually sleep i-1 seconds on windows

#;
(test-group "basic"
  (test-assert (glossed *iterations-overhead*))
  (glossed)
)

(test-group "benchmark-measure"
  (wait-message 2)
  (test-bigO "benchmark-measure returns runtime" MS/SEC (benchmark-measure (sleep 2)))
  (wait-message 1)
  (parameterize ((current-test-epsilon 0.1))
    (test "sleep 1" 1.0 (fpround/to (ms->secs (benchmark-measure (sleep 1))) 1)) )
)

(parameterize ((current-test-epsilon 0.001)
               (current-benchmark-statistics-set #t)
               (current-benchmark-iterations 3) )
  (test-group "benchmark-run"
    (let* ((runs
             (begin
               (wait-message (* (current-benchmark-iterations) 2))
               (benchmark-measure-run (begin (sleep 2)))))
           (stats
             (generate-statistics runs (current-benchmark-statistics-set))) )
      (gloss stats)
      (bigO-stats-tests MS/SEC stats '(
        max min
        95th
        arithmetic-mean harmonic-mean geometric-mean median mode)) )

    (let ((stats (benchmark-run (1) #t)))
      #;(gloss stats)
      (test "deviation for a single result" 0.0 (stats-item sd stats)) ) ) )

;#; ;wait for micro-stats validation
(parameterize ((current-test-epsilon 0.001)
               (current-benchmark-statistics-set #t)
               (current-benchmark-iterations 3) )
  (test-group "with-expected-benchmark"
    (let* ((runs
             (begin
               (wait-message (* (current-benchmark-iterations) 1))
               (benchmark-measure-run (begin (sleep 1)))))
           (stats
             (with-expected-benchmark w/run runs (sleep 1))) )
      (gloss runs)
      (gloss stats) )
  ) )

(parameterize ((current-test-epsilon 0.009)
               (current-benchmark-iterations 3) )
  (test-group "examples"
    (import (only (chicken base) sleep))

    ;simply measure the runtime of the given fragment
    (wait-message (* (current-benchmark-iterations) 2))
    ;FIXME need an inteval test (floor/round/... looses too much info)
    (test "sleep 2" 2.0 (fpround/to (ms->secs (benchmark-measure (sleep 2))) 0))

    ;run code 3 times and return results
    (wait-message (* (current-benchmark-iterations) 1))
    (parameterize ((current-test-epsilon 0.1))
      (test "sleep 1" 1.0 (fpround/to (ms->secs (stats-item mean (benchmark-run (sleep 1)))) 0)) )

    ;find out how many iterations we can make per second
    (wait-message "while it figures out how many times to sleep 2 seconds, in a second")
    (let ((stats2 (benchmark-ips (sleep 2))))
      (glossf "stats-item mean: ~A" (stats-item mean stats2))
      (test "1/2 iteration" 0.5 (fpround/to (stats-item mean stats2) 1)) )
  ) )

(test-end "micro-benchmark")

(test-exit)