R7RS test patches for Windows from Per Bothner.

This commit is contained in:
Alex Shinn 2014-02-24 21:37:40 +09:00
parent f76a9f2508
commit f5a33c3aa1

View file

@ -1633,13 +1633,13 @@
(else (else
(display "condition: " out) (display "condition: " out)
(write condition out) (write condition out)
(newline out) (display #\! out)
'exception)) 'exception))
(+ 1 (if (= v 0) (raise 'an-error) (/ 10 v))))) (+ 1 (if (= v 0) (raise 'an-error) (/ 10 v)))))
(let* ((out (open-output-string)) (let* ((out (open-output-string))
(value (test-exception-handler-3 0 out))) (value (test-exception-handler-3 0 out)))
(test 'exception value) (test 'exception value)
(test "condition: an-error\n" (get-output-string out))) (test "condition: an-error!" (get-output-string out)))
(define (test-exception-handler-4 v out) (define (test-exception-handler-4 v out)
(call-with-current-continuation (call-with-current-continuation
@ -1647,7 +1647,7 @@
(with-exception-handler (with-exception-handler
(lambda (x) (lambda (x)
(display "reraised " out) (display "reraised " out)
(write x out) (newline out) (write x out) (display #\! out)
(k 'zero)) (k 'zero))
(lambda () (lambda ()
(guard (condition (guard (condition
@ -1670,7 +1670,7 @@
;; From SRFI-34 "Examples" section - #7 ;; From SRFI-34 "Examples" section - #7
(let* ((out (open-output-string)) (let* ((out (open-output-string))
(value (test-exception-handler-4 0 out))) (value (test-exception-handler-4 0 out)))
(test "reraised 0\n" (get-output-string out)) (test "reraised 0!" (get-output-string out))
(test 'zero value)) (test 'zero value))
;; From SRFI-34 "Examples" section - #8 ;; From SRFI-34 "Examples" section - #8
@ -1780,10 +1780,10 @@
(display #\c out) (display #\c out)
(get-output-string out))) (get-output-string out)))
(test "\n" (test #t
(let ((out (open-output-string))) (let* ((out (open-output-string))
(newline out) (r (begin (newline out) (get-output-string out))))
(get-output-string out))) (or (equal? r "\n") (equal? r "\r\n"))))
(test "abc def" (test "abc def"
(let ((out (open-output-string))) (let ((out (open-output-string)))