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

(module (test-utils test)

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

(import scheme)

(define-syntax test-assert-each
  (syntax-rules ()
    ((test-assert-each ?ttl (?a0 ...) ?e ?l0 ...)
      (let ((_ttl ?ttl))
        (define (test-each-body)
          (call/cc
            (lambda (return)
              (for-each
                (lambda (?a0 ...) (unless ?e (return #f)))
                ?l0 ...)
              #t)) )
        (test-assert _ttl (test-each-body)) ) ) ) )

(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))
        (do ((i 0 (+ i 1)))
            ((= i _n) (test-assert _ttl #t))
            (unless ?e
              (test-assert _ttl #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)