(module test-compat2 mzscheme
  (require "test.ss"
           "keyword.ss")

  (provide make-test-case
           make-test-suite
           
           (rename with-check-info with-assertion-info)
           (rename with-check-info* with-assertion-info*)
           
           (rename fail-check fail-assertion)
           (rename define-check define-assertion)
           (rename define-simple-check define-simple-assertion)
           
           (rename check assert)
           (rename check* assert*)
           (rename check-exn assert-exn)
           (rename check-exn* assert-exn*)
           (rename check-not-exn assert-not-exn)
           (rename check-not-exn* assert-not-exn*)
           (rename check-true assert-true)
           (rename check-true* assert-true*)
           (rename check-false assert-false)
           (rename check-false* assert-false*)
           (rename check-pred assert-pred)
           (rename check-pred* assert-pred*)
           (rename check-eq? assert-eq?)
           (rename check-eq?* assert-eq?*)
           (rename check-eqv? assert-eqv?)
           (rename check-eqv?* assert-eqv?*)
           (rename check-equal? assert-equal?)
           (rename check-equal?* assert-equal?*)
           (rename check-not-false assert-not-false)
           (rename check-not-false* assert-not-false*)
           fail
           fail*)
  
  (define-syntax (make-test-case stx)
    (syntax-case stx ()
      [(_ name form ...)
       (let loop ([forms (syntax->list #'(form ...))]
                  [setups null]
                  [teardowns null]
                  [exprs null])
         (cond [(pair? forms)
                (let ((form0 (car forms))
                      (forms (cdr forms)))
                  (syntax-case form0 (setup teardown)
                    [setup
                     (unless (pair? forms)
                       (raise-syntax-error 
                        'make-test-case 
                        "expected subsequent expression" 
                        form0))
                     (loop (cdr forms) (cons (car forms) setups) teardowns exprs)]
                    [teardown
                     (unless (pair? forms)
                       (raise-syntax-error
                        'make-test-case
                        "expected subsequent expression"
                        form0))
                     (loop (cdr forms) setups (cons (car forms) teardowns) exprs)]
                    [else
                     (loop forms setups teardowns (cons form0 exprs))]))]
               [else
                (with-syntax ([(setup ...) (reverse setups)]
                              [(teardown ...) (reverse teardowns)]
                              [(expr ...) (reverse exprs)])
                  (if (or (pair? setups) (pair? teardowns))
                      (syntax/loc stx
                        (test-case name
                          (around
                            (begin (void) setup ...)
                            (begin (void) expr ...)
                            (begin (void teardown ...)))))
                      (syntax/loc stx
                        (test-case name (begin expr ...)))))]))]))

  (define (make-test-suite name . tests)
    (let ((setup (get-keyword-arg 'setup tests void))
          (teardown (get-keyword-arg 'teardown tests void))
          (rest (get-positional-args '(setup teardown) tests)))
      (apply test-suite name #:before setup #:after teardown rest)))

  )