1
;; FileName : test-srfi34-2.scm
2
;; About : unit test for SRFI-34 taken from "Examples" section of SRFI-34
4
;; Copyright (C) 2005-2006 YamaKen <yamaken AT bp.iij4u.or.jp>
6
;; All rights reserved.
8
;; Redistribution and use in source and binary forms, with or without
9
;; modification, are permitted provided that the following conditions
12
;; 1. Redistributions of source code must retain the above copyright
13
;; notice, this list of conditions and the following disclaimer.
14
;; 2. Redistributions in binary form must reproduce the above copyright
15
;; notice, this list of conditions and the following disclaimer in the
16
;; documentation and/or other materials provided with the distribution.
17
;; 3. Neither the name of authors nor the names of its contributors
18
;; may be used to endorse or promote products derived from this software
19
;; without specific prior written permission.
21
;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
22
;; IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
23
;; THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
24
;; PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
25
;; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
26
;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
27
;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
28
;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
29
;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
30
;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
31
;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
33
(load "./test/unittest.scm")
40
;; All tests in this file are passed against r2143 (new repository)
42
;;(set! *test-track-progress* #t)
44
;; these tests are ported from "Examples" section of SRFI-34
46
(define print-expected
48
(display " expected print: ")
51
(display " actual print: ")))
53
;;PRINTS: condition: an-error
54
(print-expected "condition: an-error")
55
(assert-equal? "Examples of SRFI-34 document #1"
57
(call-with-current-continuation
59
(with-exception-handler (lambda (x)
60
(display "condition: ")
65
(+ 1 (raise 'an-error)))))))
67
;;PRINTS: something went wrong
68
;; Then behaves in an unspecified way. Although the behavior when a handler
69
;; returned is not specified in SRFI-34, SigScheme should produce an error to
70
;; prevent being misused by users.
71
(print-expected "something went wrong")
72
(assert-error "Examples of SRFI-34 document #2"
74
(call-with-current-continuation
76
(with-exception-handler (lambda (x)
77
(display "something went wrong")
81
(+ 1 (raise 'an-error))))))))
83
;;PRINTS: condition: an-error
84
(print-expected "condition: an-error")
85
(assert-equal? "Examples of SRFI-34 document #3"
89
(display "condition: ")
93
(+ 1 (raise 'an-error))))
95
;;PRINTS: something went wrong
96
(print-expected "something went wrong")
97
(assert-equal? "Examples of SRFI-34 document #4"
101
(display "something went wrong")
104
(+ 1 (raise 'an-error))))
106
(assert-equal? "Examples of SRFI-34 document #5"
108
(call-with-current-continuation
110
(with-exception-handler (lambda (x)
111
(display "reraised ") (write x) (newline)
115
((positive? condition) 'positive)
116
((negative? condition) 'negative))
119
(assert-equal? "Examples of SRFI-34 document #6"
121
(call-with-current-continuation
123
(with-exception-handler (lambda (x)
124
(display "reraised ") (write x) (newline)
128
((positive? condition) 'positive)
129
((negative? condition) 'negative))
133
(print-expected "reraised 0")
134
(assert-equal? "Examples of SRFI-34 document #7"
136
(call-with-current-continuation
138
(with-exception-handler (lambda (x)
139
(display "reraised ") (write x) (newline)
143
((positive? condition) 'positive)
144
((negative? condition) 'negative))
147
(assert-equal? "Examples of SRFI-34 document #8"
150
((assq 'a condition) => cdr)
151
((assq 'b condition)))
152
(raise (list (cons 'a 42)))))
154
(assert-equal? "Examples of SRFI-34 document #9"
157
((assq 'a condition) => cdr)
158
((assq 'b condition)))
159
(raise (list (cons 'b 23)))))
added
removed
test/test-srfi34-2.scm
