;;; Time-stamp: <2006-11-07 11:46:16 nhw>
;;; Copyright (C) by Noel Welsh.

;;; This library is free software; you can redistribute it
;;; and/or modify it under the terms of the GNU Lesser
;;; General Public License as published by the Free Software
;;; Foundation; either version 2.1 of the License, or (at
;;; your option) any later version.

;;; This library is distributed in the hope that it will be
;;; useful, but WITHOUT ANY WARRANTY; without even the
;;; implied warranty of MERCHANTABILITY or FITNESS FOR A
;;; PARTICULAR PURPOSE.  See the GNU Lesser General Public
;;; License for more details.

;;; You should have received a copy of the GNU Lesser
;;; General Public License along with this library; if not,
;;; write to the Free Software Foundation, Inc., 59 Temple
;;; Place, Suite 330, Boston, MA 02111-1307 USA

;;; Author: Noel Welsh <>
;; Commentary:

(module si-text-ui mzscheme

   (lib "")
   (planet "" ("schematics" "schemeunit.plt" 2 1))
   (planet "" ("schematics" "schemeunit.plt" 2 1))
   (planet "plt/" ("schematics" "schemeunit.plt" 2 1))
   (planet "plt/" ("schematics" "schemeunit.plt" 2 1))
   (planet "plt/" ("schematics" "schemeunit.plt" 2 1))
   (file "")
   (file "")
   (file ""))

  (provide test/si-text-ui)

  (define (save-results name)
    (define (write-results successes failures errors bugs)
      (lambda (monad)
         (name->database-name name)
         (lambda (db)
            (create-sample name successes failures errors bugs))))
      ((vector s f e b)
       (write-results s f e b)))))

  (define (si-display-summary+return monad)
          ((vector s f e b)
           (return-hash (+ f e)))))
  ;; test/si-text-ui : symbol test -> int
  (define (test/si-text-ui name test)
      (lambda (monad)
        (foldts (lambda (suite name before after seed)
                  ((push-suite-name! name) seed))
                (lambda (suite name before after seed kid-seed)
                  ((pop-suite-name!) kid-seed))
                (lambda (case name action seed)
                  (let ((result (run-test-case name action)))
                    ((sequence* (update-counter! case result)
                                (display-test-case-name result)
                                (lambda (hash)
                                  (display-result result)
                                  (display-check-info result)
      (save-results name)