;;;;

(import test)

(import (only (chicken format) format))
(include "test-gloss.incl")

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

(define (wait-message) (gloss "Please Wait ..."))

;;

(test-begin "micro-benchmark")

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

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

;(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)
  (test-bigO "benchmark-measure returns runtime" MS/SEC (benchmark-measure (sleep 2)))
  (wait-message)
  (parameterize ((current-test-epsilon 0.009))
    (test 1.00 (ms->secs (benchmark-measure (sleep 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)
               (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)
               (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)
    (test 2.00 (ms->secs (benchmark-measure (sleep 2))))

    ;run code 3 times and return results
    (wait-message)
    (test 1.00 (ms->secs (stats-item mean (benchmark-run (sleep 1)))))

    ;find out how many iterations we can make per second
    (wait-message)
    (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)