mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-23 20:15:05 +02:00
tests/base.scm: add two tests for issue #556
The two tests are adapted from issue #556 (originally from r7rs). The tests currently fail because errors and raised objects are treated in the same way.
This commit is contained in:
parent
b4aaa28d49
commit
d6357c9808
1 changed files with 41 additions and 1 deletions
|
@ -11,6 +11,7 @@
|
||||||
(scheme base)
|
(scheme base)
|
||||||
(scheme eval)
|
(scheme eval)
|
||||||
(scheme inexact)
|
(scheme inexact)
|
||||||
|
(scheme write)
|
||||||
(cyclone test))
|
(cyclone test))
|
||||||
|
|
||||||
|
|
||||||
|
@ -54,7 +55,6 @@
|
||||||
(test "o" (read-line p))
|
(test "o" (read-line p))
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
(else #f)
|
|
||||||
)
|
)
|
||||||
|
|
||||||
(test-group
|
(test-group
|
||||||
|
@ -172,5 +172,45 @@
|
||||||
(test #f (memq 0.0 (list m)))
|
(test #f (memq 0.0 (list m)))
|
||||||
)
|
)
|
||||||
|
|
||||||
|
(test-group
|
||||||
|
"exception handling"
|
||||||
|
(define (capture-output thunk)
|
||||||
|
(let ((output-string (open-output-string)))
|
||||||
|
(parameterize ((current-output-port output-string))
|
||||||
|
(thunk))
|
||||||
|
(let ((result (get-output-string output-string)))
|
||||||
|
(close-output-port output-string)
|
||||||
|
result)))
|
||||||
|
(test
|
||||||
|
"should be a number65"
|
||||||
|
(capture-output
|
||||||
|
(lambda ()
|
||||||
|
(with-exception-handler
|
||||||
|
(lambda (con)
|
||||||
|
(cond
|
||||||
|
((string? con)
|
||||||
|
(display con))
|
||||||
|
(else
|
||||||
|
(display "a warning has been issued")))
|
||||||
|
42)
|
||||||
|
(lambda ()
|
||||||
|
(display
|
||||||
|
(+ (raise-continuable "should be a number")
|
||||||
|
23)))))))
|
||||||
|
(test
|
||||||
|
"condition: an-error"
|
||||||
|
(capture-output
|
||||||
|
(lambda ()
|
||||||
|
(call-with-current-continuation
|
||||||
|
(lambda (k)
|
||||||
|
(with-exception-handler
|
||||||
|
(lambda (x)
|
||||||
|
(display "condition: ")
|
||||||
|
(write x)
|
||||||
|
(k "exception"))
|
||||||
|
(lambda ()
|
||||||
|
(+ 1 (raise 'an-error)))))))))
|
||||||
|
)
|
||||||
|
|
||||||
(test-exit)
|
(test-exit)
|
||||||
|
|
||||||
|
|
Loading…
Add table
Reference in a new issue