unlock some of exception tests
This commit is contained in:
Yuichi Nishiwaki
parent
077cb8bcfa
commit
a75a48fc8f
174
t/r7rs-tests.scm
174
t/r7rs-tests.scm
|
|
@ -1619,29 +1619,29 @@
|
||||||
|
|
||||||
(test-begin "6.11 Exceptions")
|
(test-begin "6.11 Exceptions")
|
||||||
|
|
||||||
;; (test 65
|
(test 65
|
||||||
;; (with-exception-handler
|
(with-exception-handler
|
||||||
;; (lambda (con) 42)
|
(lambda (con) 42)
|
||||||
;; (lambda ()
|
(lambda ()
|
||||||
;; (+ (raise-continuable "should be a number")
|
(+ (raise-continuable "should be a number")
|
||||||
;; 23))))
|
23))))
|
||||||
|
|
||||||
;; (test #t
|
(test #t
|
||||||
;; (error-object? (guard (exn (else exn)) (error "BOOM!" 1 2 3))))
|
(error-object? (guard (exn (else exn)) (error "BOOM!" 1 2 3))))
|
||||||
;; (test "BOOM!"
|
;; (test "BOOM!"
|
||||||
;; (error-object-message (guard (exn (else exn)) (error "BOOM!" 1 2 3))))
|
;; (error-object-message (guard (exn (else exn)) (error "BOOM!" 1 2 3))))
|
||||||
;; (test '(1 2 3)
|
;; (test '(1 2 3)
|
||||||
;; (error-object-irritants (guard (exn (else exn)) (error "BOOM!" 1 2 3))))
|
;; (error-object-irritants (guard (exn (else exn)) (error "BOOM!" 1 2 3))))
|
||||||
|
|
||||||
;; (test #f
|
(test #f
|
||||||
;; (file-error? (guard (exn (else exn)) (error "BOOM!"))))
|
(file-error? (guard (exn (else exn)) (error "BOOM!"))))
|
||||||
;; (test #t
|
(test #t
|
||||||
;; (file-error? (guard (exn (else exn)) (open-input-file " no such file "))))
|
(file-error? (guard (exn (else exn)) (open-input-file " no such file "))))
|
||||||
|
|
||||||
;; (test #f
|
(test #f
|
||||||
;; (read-error? (guard (exn (else exn)) (error "BOOM!"))))
|
(read-error? (guard (exn (else exn)) (error "BOOM!"))))
|
||||||
;; (test #t
|
(test #t
|
||||||
;; (read-error? (guard (exn (else exn)) (read (open-input-string ")")))))
|
(read-error? (guard (exn (else exn)) (read (open-input-string ")")))))
|
||||||
|
|
||||||
(define something-went-wrong #f)
|
(define something-went-wrong #f)
|
||||||
(define (test-exception-handler-1 v)
|
(define (test-exception-handler-1 v)
|
||||||
|
|
@ -1659,86 +1659,86 @@
|
||||||
(test '("condition: " an-error) something-went-wrong)
|
(test '("condition: " an-error) something-went-wrong)
|
||||||
|
|
||||||
(set! something-went-wrong #f)
|
(set! something-went-wrong #f)
|
||||||
;; (define (test-exception-handler-2 v)
|
(define (test-exception-handler-2 v)
|
||||||
;; (guard (ex (else 'caught-another-exception))
|
(guard (ex (else 'caught-another-exception))
|
||||||
;; (with-exception-handler
|
(with-exception-handler
|
||||||
;; (lambda (x)
|
(lambda (x)
|
||||||
;; (set! something-went-wrong #t)
|
(set! something-went-wrong #t)
|
||||||
;; (list "exception:" x))
|
(list "exception:" x))
|
||||||
;; (lambda ()
|
(lambda ()
|
||||||
;; (+ 1 (if (> v 0) (+ v 100) (raise 'an-error)))))))
|
(+ 1 (if (> v 0) (+ v 100) (raise 'an-error)))))))
|
||||||
;; (test 106 (test-exception-handler-2 5))
|
(test 106 (test-exception-handler-2 5))
|
||||||
;; (test #f something-went-wrong)
|
(test #f something-went-wrong)
|
||||||
;; (test 'caught-another-exception (test-exception-handler-2 -1))
|
(test 'caught-another-exception (test-exception-handler-2 -1))
|
||||||
;; (test #t something-went-wrong)
|
(test #t something-went-wrong)
|
||||||
|
|
||||||
;; Based on an example from R6RS-lib section 7.1 Exceptions.
|
;; Based on an example from R6RS-lib section 7.1 Exceptions.
|
||||||
;; R7RS section 6.11 Exceptions has a simplified version.
|
;; R7RS section 6.11 Exceptions has a simplified version.
|
||||||
;; (let* ((out (open-output-string))
|
(let* ((out (open-output-string))
|
||||||
;; (value (with-exception-handler
|
(value (with-exception-handler
|
||||||
;; (lambda (con)
|
(lambda (con)
|
||||||
;; (cond
|
(cond
|
||||||
;; ((not (list? con))
|
((not (list? con))
|
||||||
;; (raise con))
|
(raise con))
|
||||||
;; ((list? con)
|
((list? con)
|
||||||
;; (display (car con) out))
|
(display (car con) out))
|
||||||
;; (else
|
(else
|
||||||
;; (display "a warning has been issued" out)))
|
(display "a warning has been issued" out)))
|
||||||
;; 42)
|
42)
|
||||||
;; (lambda ()
|
(lambda ()
|
||||||
;; (+ (raise-continuable
|
(+ (raise-continuable
|
||||||
;; (list "should be a number"))
|
(list "should be a number"))
|
||||||
;; 23)))))
|
23)))))
|
||||||
;; (test "should be a number" (get-output-string out))
|
(test "should be a number" (get-output-string out))
|
||||||
;; (test 65 value))
|
(test 65 value))
|
||||||
|
|
||||||
;; From SRFI-34 "Examples" section - #3
|
;; From SRFI-34 "Examples" section - #3
|
||||||
;; (define (test-exception-handler-3 v out)
|
(define (test-exception-handler-3 v out)
|
||||||
;; (guard (condition
|
(guard (condition
|
||||||
;; (else
|
(else
|
||||||
;; (display "condition: " out)
|
(display "condition: " out)
|
||||||
;; (write condition out)
|
(write condition out)
|
||||||
;; (display #\! 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!" (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
|
||||||
;; (lambda (k)
|
(lambda (k)
|
||||||
;; (with-exception-handler
|
(with-exception-handler
|
||||||
;; (lambda (x)
|
(lambda (x)
|
||||||
;; (display "reraised " out)
|
(display "reraised " out)
|
||||||
;; (write x out) (display #\! out)
|
(write x out) (display #\! out)
|
||||||
;; (k 'zero))
|
(k 'zero))
|
||||||
;; (lambda ()
|
(lambda ()
|
||||||
;; (guard (condition
|
(guard (condition
|
||||||
;; ((positive? condition)
|
((positive? condition)
|
||||||
;; 'positive)
|
'positive)
|
||||||
;; ((negative? condition)
|
((negative? condition)
|
||||||
;; 'negative))
|
'negative))
|
||||||
;; (raise v)))))))
|
(raise v)))))))
|
||||||
|
|
||||||
;; From SRFI-34 "Examples" section - #5
|
;; From SRFI-34 "Examples" section - #5
|
||||||
;; (let* ((out (open-output-string))
|
(let* ((out (open-output-string))
|
||||||
;; (value (test-exception-handler-4 1 out)))
|
(value (test-exception-handler-4 1 out)))
|
||||||
;; (test "" (get-output-string out))
|
(test "" (get-output-string out))
|
||||||
;; (test 'positive value))
|
(test 'positive value))
|
||||||
;; ;; From SRFI-34 "Examples" section - #6
|
;; From SRFI-34 "Examples" section - #6
|
||||||
;; (let* ((out (open-output-string))
|
(let* ((out (open-output-string))
|
||||||
;; (value (test-exception-handler-4 -1 out)))
|
(value (test-exception-handler-4 -1 out)))
|
||||||
;; (test "" (get-output-string out))
|
(test "" (get-output-string out))
|
||||||
;; (test 'negative value))
|
(test 'negative value))
|
||||||
;; ;; 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!" (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
|
||||||
;; (test 42
|
;; (test 42
|
||||||
;; (guard (condition
|
;; (guard (condition
|
||||||
;; ((assq 'a condition) => cdr)
|
;; ((assq 'a condition) => cdr)
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue