(module test mzscheme
        
 (provide test current-test-name test-report test-abort-option test-show-option reset)
        
 (require (file "c:/scheme/kcollects/show/show.scm"))
        
 (define-syntax test
  (syntax-rules ()
   ((test (expr1 expr ...) (expected-values ...))
    (test (expr1 expr ...) (expected-values ...) "" ""))
   ((test (expr1 expr ...) (expected-values ...) expected-output)
    (test (expr1 expr ...) (expected-values ...) expected-output ""))
   ((test (expr1 expr ...) (expected-values ...) expected-output expected-error)
    (test-proc
     (lambda () (eval '(begin expr1 expr ...)))
    `(expr1 expr ...)
    `(expected-values ...)
    `expected-output
    `expected-error))
   ((test name rest ...) (begin (current-test-name 'name) (test rest ...)))))
 
 (define fail-list ())
 (define (reset) (set! fail-list ()) (current-test-name 'no-name) (set! error-cntr 0))
 
 (define (test-proc thunk exprs expected-values expected-output expected-error)
  (define saved-output-port (current-output-port))
  (define saved-exception-handler (current-exception-handler))
  (define saved-escape-handler (error-escape-handler))
  (define (exception-handler exn)
   (display (exn-message exn) error-string) (saved-exception-handler exn))
  (define xescape-handler (lambda () (exit (void))))
  (define output-string (open-output-string))
  (define error-string (open-output-string))
  (define exit #f)
  (define (prelude)
   (current-output-port output-string)
   (current-exception-handler exception-handler)
   (error-escape-handler xescape-handler))
  (define (postlude)
   (current-output-port saved-output-port)
   (current-exception-handler saved-exception-handler)
   (error-escape-handler saved-escape-handler))
  (define (escaping-thunk) (let/ec ec (set! exit ec) (thunk)))
  (let
   ((computed-values
     (call-with-values
      (lambda () (dynamic-wind prelude escaping-thunk postlude)) list)))
   (let
    ((computed-output (get-output-string output-string))
     (computed-error (get-output-string error-string)))
    (let 
     ((correct-value? (equal? computed-values expected-values))
      (correct-output? (equal? computed-output expected-output))
      (correct-error? (equal? computed-error expected-error)))
     (define (show-test-results str)
      (show "==============================================================")
      (show "Test:" (current-test-name) '/ test-cntr str)
      (apply show "Expressions:" exprs)
      (apply show "Expected values:" expected-values)
      (apply show "Computed-values:" (if correct-value? '(correct) computed-values))
      (show "Expected output:" expected-output)
      (show "Computed-output:" (if correct-output? '(correct) computed-output))
      (show "Expected error:" expected-error)
      (show "Computed-error:" (if correct-error? '(correct) computed-error))
      (show "=============================================================="))
     (cond
      ((and correct-value? correct-output? correct-error?)
       (if (test-show-option) (show-test-results "Succeeded")))
      (else
       (set! fail-list (append fail-list (list (list (current-test-name) '/ test-cntr))))
       (show-test-results "FAILED!!!")
       (set! error-cntr (add1 error-cntr))
       (if (test-abort-option)
        (error "Test failed on test:" (current-test-name) '/ test-cntr))))
     (set! test-cntr (add1 test-cntr))))))
   
 (define test-report
  (case-lambda
   (() (test-report #t))
   ((abort?)
    (void
     (if (zero? error-cntr) (show "Test summary: all tests succeeded.")
     (begin
      (show "Test summary:" error-cntr "tests FAILED!!!")
      (show fail-list)
      (if abort? (error "test-report: one or more tetsts FAILED."))))))))
 
 (define error-cntr 0)
 (define test-cntr 0)

 (define current-test-name
  (make-parameter 'who-cares?
   (lambda (x) (set! test-cntr 0) x)))
  
 (define test-abort-option  (make-parameter #f))
 (define test-show-option   (make-parameter #f)))