← Back to branch summary

~ubuntu-branches/ubuntu/hardy/sigscheme/hardy-proposed

« back to all changes in this revision

Viewing changes to test/test-srfi34-2.scm

  • Committer: Bazaar Package Importer
  • Author(s): NIIBE Yutaka
  • Date: 2007-01-29 15:31:24 UTC
  • mfrom: (1.1.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070129153124-j5fcqyrwcfbczma7
Tags: 0.7.4-1
New upstream release.

Show diffs side-by-side

added added

removed removed

Lines of Context:
test/test-srfi34-2.scm
2
2
;;  About    : unit test for SRFI-34 taken from "Examples" section of SRFI-34
3
3
;;
4
4
;;  Copyright (C) 2005-2006 YAMAMOTO Kengo <yamaken AT bp.iij4u.or.jp>
 
5
;;  Copyright (c) 2007 SigScheme Project <uim AT freedesktop.org>
5
6
;;
6
7
;;  All rights reserved.
7
8
;;
32
33
 
33
34
(load "./test/unittest.scm")
34
35
 
35
 
(cond-expand
36
 
 (sigscheme
37
 
  (use srfi-34))
38
 
 (else #t))
39
 
 
40
 
;; All tests in this file are passed against r2143 (new repository)
41
 
 
42
 
;;(set! *test-track-progress* #t)
 
36
(use srfi-34)
 
37
 
 
38
(if (not (provided? "srfi-34"))
 
39
    (test-skip "SRFI-34 is not enabled"))
 
40
 
 
41
(define tn test-name)
 
42
 
 
43
(set! *test-track-progress* #f)
43
44
 
44
45
;; these tests are ported from "Examples" section of SRFI-34
45
46
 
46
 
(define print-expected
47
 
  (lambda (expected)
48
 
    (display " expected print: ")
49
 
    (display expected)
50
 
    (newline)
51
 
    (display "   actual print: ")))
 
47
(tn "Examples of SRFI-34 document")
52
48
 
53
49
;;PRINTS: condition: an-error
54
50
(print-expected "condition: an-error")
55
 
(assert-equal? "Examples of SRFI-34 document #1"
 
51
(assert-equal? (tn)
56
52
               'exception
57
53
               (call-with-current-continuation
58
54
                (lambda (k)
69
65
;; returned is not specified in SRFI-34, SigScheme should produce an error to
70
66
;; prevent being misused by users.
71
67
(print-expected "something went wrong")
72
 
(assert-error "Examples of SRFI-34 document #2"
 
68
(assert-error (tn)
73
69
              (lambda ()
74
70
                (call-with-current-continuation
75
71
                 (lambda (k)
82
78
 
83
79
;;PRINTS: condition: an-error
84
80
(print-expected "condition: an-error")
85
 
(assert-equal? "Examples of SRFI-34 document #3"
 
81
(assert-equal? (tn)
86
82
               'exception
87
83
               (guard (condition
88
84
                       (else
94
90
 
95
91
;;PRINTS: something went wrong
96
92
(print-expected "something went wrong")
97
 
(assert-equal? "Examples of SRFI-34 document #4"
 
93
(assert-equal? (tn)
98
94
               'dont-care
99
95
               (guard (condition
100
96
                       (else
103
99
                        'dont-care))
104
100
                 (+ 1 (raise 'an-error))))
105
101
 
106
 
(assert-equal? "Examples of SRFI-34 document #5"
 
102
(assert-equal? (tn)
107
103
               'positive
108
104
               (call-with-current-continuation
109
105
                (lambda (k)
116
112
                              ((negative? condition) 'negative))
117
113
                        (raise 1)))))))
118
114
 
119
 
(assert-equal? "Examples of SRFI-34 document #6"
 
115
(assert-equal? (tn)
120
116
               'negative
121
117
               (call-with-current-continuation
122
118
                (lambda (k)
131
127
 
132
128
;;PRINTS: reraised 0
133
129
(print-expected "reraised 0")
134
 
(assert-equal? "Examples of SRFI-34 document #7"
 
130
(assert-equal? (tn)
135
131
               'zero
136
132
               (call-with-current-continuation
137
133
                (lambda (k)
144
140
                              ((negative? condition) 'negative))
145
141
                        (raise 0)))))))
146
142
 
147
 
(assert-equal? "Examples of SRFI-34 document #8"
 
143
(assert-equal? (tn)
148
144
               42
149
145
               (guard (condition
150
146
                       ((assq 'a condition) => cdr)
151
147
                       ((assq 'b condition)))
152
148
                 (raise (list (cons 'a 42)))))
153
149
 
154
 
(assert-equal? "Examples of SRFI-34 document #9"
 
150
(assert-equal? (tn)
155
151
               '(b . 23)
156
152
               (guard (condition
157
153
                       ((assq 'a condition) => cdr)