;;; Time-stamp: <2008-06-19 22:16:19 noel>
;;; 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:

#lang scheme/base

(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)))))