;;;; test-utils.test.scm  -*- Scheme -*-

(module (test-utils test)

(;export
  test-each
  test-assert-each
  test-assert-times
  test-times)

(import scheme)

#| ;FIXME
- title from bindings
- test value from bindings
- multiple values
|#

(define-syntax test-assert-each
  (syntax-rules ()
    ((test-assert-each ?ttl (?a0 ...) ?e ?l0 ...)
      (let ((_ttl ?ttl))
        (define (test-each-body)
          (let ((nth 0))
            (call/cc
              (lambda (return)
                (for-each
                  (lambda (?a0 ...)
                    (set! nth (+ nth 1))
                    (unless ?e (return #f nth)) )
                  ?l0 ...)
                (values #t nth) ) ) ) )
        (let-values (((all-pass nth) (test-each-body)))
          (let ((msg (if all-pass _ttl
                         (string-append _ttl " (@ #" (number->string nth) ")"))))
            (test-assert msg all-pass) ) ) ) ) ) )

(define-syntax test-each
  (syntax-rules ()
    ((test-each ?ttl ?vs (?a0 ...) ?e ?l0 ...)
      (let ((_tst (current-test-comparator)))
        (test-assert-each ?ttl (v ?a0 ...) (_tst v ?e) ?vs ?l0 ...) ) ) ) )

(define-syntax test-assert-times
  (syntax-rules ()
    ((test-assert-times ?ttl ?n ?e)
      (let ((_ttl ?ttl) (_n ?n))
        (call/cc
          (lambda (return)
            (do ((i 0 (+ i 1)))
                ((= i _n) (test-assert _ttl #t))
              (unless ?e
                (let ((msg (string-append _ttl " (@ #" (number->string (+ i 1)) ")")))
                (return (test-assert msg #f)) ) ) ) ) ) ) ) ) )

(define-syntax test-times
  (syntax-rules ()
    ((test-times ?ttl ?n ?v ?e)
      (let ((_tst (current-test-comparator)))
        (test-assert-times ?ttl ?n (_tst ?v ?e)) ) ) ) )

) ;module (test-utils test)