scsh-0.6/scheme/debug/test.scm

35 lines
908 B
Scheme
Raw Normal View History

1999-09-14 08:45:02 -04:00
; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; ,config ,load debug/test.scm
(define-structure testing (export (test :syntax) lost?)
(open scheme signals handle conditions)
(begin
(define *lost?* #f)
(define (lost?) *lost?*)
(define (run-test string compare want thunk)
(let ((result
(call-with-current-continuation
(lambda (k)
(with-handler (lambda (condition punt)
(if (error? condition)
(k condition)
(punt)))
thunk)))))
(if (not (compare want result))
(begin (display "Test ") (write string) (display " failed.") (newline)
(display "Wanted ") (write want)
(display ", but got ") (write result) (display ".")
(newline)
(set! *lost?* #t)))))
(define-syntax test
(syntax-rules ()
((test ?string ?compare ?want ?exp)
(run-test ?string ?compare ?want (lambda () ?exp)))))
))