;;;;

(import test)

#; ;FIXME
(import (chicken format) (test-utils gloss format) (test-utils gloss basic))
(import (chicken format) (test-utils gloss))

(import (test-utils run))

;Must set 1st thing
(runid 'EGG-NAME "test-utils")

;NOTE order
(define *tests* '("./test-utils-test.scm" "./three-test.scm" "./two-test.scm"))

(test-group "run-ident"
  (test-error "not alist is error" (run-ident 23))
  (test-error "bad alist is ferror" (run-ident '((23 . #f) "doesn't matter")))

  (test-group "does update"
    (let ((new '((a . #f) (b . #t) (c . 23)))
          (old (run-ident)) )
      (test-assert "cur is new" (list? (run-ident new)))
      (test "new is cur" new (run-ident))
      (test-assert "cur is old" (list? (run-ident old))) )
  )
)

(test-group "test-order<?"
  (define +tst+ (reverse *tests*))
  (define +len+ (length +tst+))
  (define +mid+ (floor (/ +len+ 2)))
  (define t<? (test-list-order< +tst+))

  ;same as (test-assert (<= 3 +len+))
  (test-assert (< 0 +mid+ (sub1 +len+)))

  (test-assert (t<? (list-ref +tst+ 0) (list-ref +tst+ (sub1 +len+))))
  (test-assert (not (t<? (list-ref +tst+ (sub1 +len+)) (list-ref +tst+ 0))))
  (test-assert (t<? (list-ref +tst+ 0) (list-ref +tst+ +mid+)))
  (test-assert (not (t<? (list-ref +tst+ +mid+) (list-ref +tst+ 0))))
  (test-assert (t<? (list-ref +tst+ +mid+) (list-ref +tst+ (sub1 +len+))))
  (test-assert (not (t<? (list-ref +tst+ (sub1 +len+)) (list-ref +tst+ +mid+))))
)

(test-group "runner"
  (test "test-utils" (runid 'EGG-NAME))
  (test "default dir" "." (runid 'test-directory))
  (test "default ext" "scm" (runid 'test-extension))

  (glossf "run-ident: ~S" (run-ident))
  (test-group "level 1"
    (define (empty-before id)
      (test (string-append "empty " (symbol->string id)) '() (runid id)))

    (gloss "level 1 (before 1st test)")
    (test-group "check using deprecated names"
      (for-each empty-before
                '(*csi-options*
                  *csi-excl-options*
                  *csc-options*
                  *csc-excl-options*
                  *test-excl-names*))
    )
    (gloss "level 1 (after 1st test)")

    (test "lexo test order" string<? (runid 'test-order))
    (test-group "level 2"
      (gloss "level 2 (before 1st test)")
      (test "expected test-lineup" *tests* (test-lineup))
      (gloss "level 2 (after 1st test)")
    )
  )
)

(test-group "test order"
  (define (myord a b)
    (import (chicken pathname))
    (test-assert "expected order arguments"
      (and (not (pathname-directory a))
           (equal? (pathname-directory a) (pathname-directory b))
           (not (pathname-extension a))
           (equal? (pathname-extension a) (pathname-extension b))))
      (string<? a b) )
  (test-assert "successful reset" (not (test-lineup #f)))
  (test "change order" myord (runid 'test-order myord))
  (test "changed order" myord (runid 'test-order))
  (let ((res (test-lineup)))
    (test "expected test-lineup" *tests* res) )
  (test "reset order" string<? (runid 'test-order string<?))
)

;quit when not ahead
(when (positive? (test-failure-count)) (test-exit))
(gloss "Hello 1, 3 & 2")
(run-tests)