;;; Time-stamp: <05/10/07 13:48:31 nhw>
;;; Copyright (C) 2005 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 name-collector mzscheme

  (require ""
           (lib "" "srfi" "1"))

  (provide display-test-case-name

  (define key (gensym))

  ;; put-initial-name : () -> (hash-monad-of void)
  (define (put-initial-name)
    (put key null))

  ;; display-test-case-name : test-result -> (hash-monad-of void)
  (define (display-test-case-name result)
     (get key)
     (lambda (names)
        ((test-success? result) (return-hash (void)))
          (lambda (name seed)
            (printf "~a > " name))
         (display (test-result-test-case-name result))
         (return-hash (void)))))))

  ;; push-suite-name! : string -> (hash-monad-of void)
  (define (push-suite-name! name)
     (get key)
     (lambda (names)
       (put key (cons name names)))))

  ;; pop-suite-name! :  -> (hash-monad-of void)
  (define (pop-suite-name!)
     (get key)
     (lambda (names)
       (put key (cdr names)))))