33 lines
1.2 KiB
Scheme
33 lines
1.2 KiB
Scheme
;;; Copyright (c) 2000-2015 Andrew W. Keep, R. Kent Dybvig
|
|
;;; See the accompanying file Copyright for details
|
|
|
|
(library (tests unit-test-helpers-implementation)
|
|
(export with-output-to-string display-condition format-error-message)
|
|
(import (vicare))
|
|
|
|
(define display-condition
|
|
(case-lambda
|
|
[(c) (display-condition c (current-output-port))]
|
|
[(c op)
|
|
(display
|
|
(format "~a~a~a~a~a"
|
|
(if (warning? c) "Warning" "Exception")
|
|
(if (who-condition? c) (format " in ~s" (condition-who c)) "")
|
|
(if (message-condition? c) (format ": ~a" (condition-message c)) "")
|
|
(if (and (irritants-condition? c) (not (null? (condition-irritants c))))
|
|
(format " with irritants ~s" (condition-irritants c))
|
|
"")
|
|
(if (syntax-violation? c)
|
|
(if (syntax-violation-subform c)
|
|
(format "~s in ~s" (syntax-violation-subform c) (syntax-violation-form c))
|
|
(format "~s" (syntax-violation-form c)))
|
|
""))
|
|
op)]))
|
|
|
|
(define-syntax format-error-message
|
|
(syntax-rules ()
|
|
[(_ args ...) (format args ...)]))
|
|
|
|
;; needed to get an r6rs script to print with vicare
|
|
(current-output-port (current-error-port)))
|