1 ;;; r6rs-base.test --- Test suite for R6RS (rnrs base)
3 ;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
5 ;; This library is free software; you can redistribute it and/or
6 ;; modify it under the terms of the GNU Lesser General Public
7 ;; License as published by the Free Software Foundation; either
8 ;; version 3 of the License, or (at your option) any later version.
10 ;; This library is distributed in the hope that it will be useful,
11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 ;; Lesser General Public License for more details.
15 ;; You should have received a copy of the GNU Lesser General Public
16 ;; License along with this library; if not, write to the Free Software
17 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
20 (define-module (test-suite test-r6rs-base)
21 :use-module ((rnrs base) :version (6))
22 :use-module ((rnrs conditions) :version (6))
23 :use-module ((rnrs exceptions) :version (6))
24 :use-module (test-suite lib))
27 ;; numbers are considered =? if their difference is less than a set
29 (define (=? alpha beta)
30 (< (abs (- alpha beta)) 1e-10))
32 (with-test-prefix "log (2nd arg)"
33 (pass-if "log positive-base" (=? (log 8 2) 3))
34 (pass-if "log negative-base" (=? (real-part (log 256 -4))
36 (pass-if "log base-one" (= (log 10 1) +inf.0))
37 (pass-if "log base-zero"
39 (lambda () (log 10 0) #f)
42 (with-test-prefix "boolean=?"
43 (pass-if "boolean=? null" (boolean=?))
44 (pass-if "boolean=? unary" (boolean=? #f))
45 (pass-if "boolean=? many"
46 (and (boolean=? #t #t #t)
48 (not (boolean=? #t #f #t))))
49 (pass-if "boolean=? mixed type" (not (boolean=? #t #t 'foo))))
51 (with-test-prefix "symbol=?"
52 (pass-if "symbol=? null" (symbol=?))
53 (pass-if "symbol=? unary" (symbol=? 'a))
54 (pass-if "symbol=? many"
55 (and (symbol=? 'a 'a 'a)
56 (symbol=? 'foo 'foo 'foo)
57 (not (symbol=? 'a 'foo 'a))))
58 (pass-if "symbol=? mixed type" (not (symbol=? 'a 'a 123))))
60 (with-test-prefix "infinite?"
61 (pass-if "infinite? true on infinities"
62 (and (infinite? +inf.0) (infinite? -inf.0)))
63 (pass-if "infinite? false on non-infities"
64 (and (not (infinite? 123)) (not (infinite? +nan.0)))))
66 (with-test-prefix "finite?"
67 (pass-if "finite? false on infinities"
68 (and (not (finite? +inf.0)) (not (finite? -inf.0))))
69 (pass-if "finite? true on non-infinities"
70 (and (finite? 123) (finite? 123.0))))
72 (with-test-prefix "exact-integer-sqrt"
73 (pass-if "exact-integer-sqrt simple"
74 (let-values (((s e) (exact-integer-sqrt 5)))
75 (and (eqv? s 2) (eqv? e 1)))))
77 (with-test-prefix "integer-valued?"
78 (pass-if "true on integers"
79 (and (integer-valued? 3) (integer-valued? 3.0) (integer-valued? 3.0+0.0i)))
80 (pass-if "false on rationals" (not (integer-valued? 3.1)))
81 (pass-if "false on reals" (not (integer-valued? +nan.0))))
83 (with-test-prefix "rational-valued?"
84 (pass-if "true on integers" (rational-valued? 3))
85 (pass-if "true on rationals"
86 (and (rational-valued? 3.1) (rational-valued? 3.1+0.0i)))
87 (pass-if "false on reals"
88 (or (not (rational-valued? +nan.0))
89 (throw 'unresolved))))
91 (with-test-prefix "real-valued?"
92 (pass-if "true on integers" (real-valued? 3))
93 (pass-if "true on rationals" (real-valued? 3.1))
94 (pass-if "true on reals" (real-valued? +nan.0)))
96 (with-test-prefix "vector-for-each"
97 (pass-if "vector-for-each simple"
99 (vector-for-each (lambda (x) (set! sum (+ sum x))) '#(1 2 3))
102 (with-test-prefix "vector-map"
103 (pass-if "vector-map simple"
104 (equal? '#(3 2 1) (vector-map (lambda (x) (- 4 x)) '#(1 2 3)))))
106 (with-test-prefix "real-valued?"
107 (pass-if (real-valued? +nan.0))
108 (pass-if (real-valued? +nan.0+0i))
109 (pass-if (real-valued? +nan.0+0.0i))
110 (pass-if (real-valued? +inf.0))
111 (pass-if (real-valued? -inf.0))
112 (pass-if (real-valued? +inf.0+0.0i))
113 (pass-if (real-valued? -inf.0-0.0i))
114 (pass-if (real-valued? 3))
115 (pass-if (real-valued? -2.5))
116 (pass-if (real-valued? -2.5+0i))
117 (pass-if (real-valued? -2.5+0.0i))
118 (pass-if (real-valued? -2.5-0i))
119 (pass-if (real-valued? #e1e10))
120 (pass-if (real-valued? 1e200))
121 (pass-if (real-valued? 1e200+0.0i))
122 (pass-if (real-valued? 6/10))
123 (pass-if (real-valued? 6/10+0.0i))
124 (pass-if (real-valued? 6/10+0i))
125 (pass-if (real-valued? 6/3))
126 (pass-if (not (real-valued? 3+i)))
127 (pass-if (not (real-valued? -2.5+0.01i)))
128 (pass-if (not (real-valued? +nan.0+0.01i)))
129 (pass-if (not (real-valued? +nan.0+nan.0i)))
130 (pass-if (not (real-valued? +inf.0-0.01i)))
131 (pass-if (not (real-valued? +0.01i)))
132 (pass-if (not (real-valued? -inf.0i))))
134 (with-test-prefix "rational-valued?"
135 (pass-if (not (rational-valued? +nan.0)))
136 (pass-if (not (rational-valued? +nan.0+0i)))
137 (pass-if (not (rational-valued? +nan.0+0.0i)))
138 (pass-if (not (rational-valued? +inf.0)))
139 (pass-if (not (rational-valued? -inf.0)))
140 (pass-if (not (rational-valued? +inf.0+0.0i)))
141 (pass-if (not (rational-valued? -inf.0-0.0i)))
142 (pass-if (rational-valued? 3))
143 (pass-if (rational-valued? -2.5))
144 (pass-if (rational-valued? -2.5+0i))
145 (pass-if (rational-valued? -2.5+0.0i))
146 (pass-if (rational-valued? -2.5-0i))
147 (pass-if (rational-valued? #e1e10))
148 (pass-if (rational-valued? 1e200))
149 (pass-if (rational-valued? 1e200+0.0i))
150 (pass-if (rational-valued? 6/10))
151 (pass-if (rational-valued? 6/10+0.0i))
152 (pass-if (rational-valued? 6/10+0i))
153 (pass-if (rational-valued? 6/3))
154 (pass-if (not (rational-valued? 3+i)))
155 (pass-if (not (rational-valued? -2.5+0.01i)))
156 (pass-if (not (rational-valued? +nan.0+0.01i)))
157 (pass-if (not (rational-valued? +nan.0+nan.0i)))
158 (pass-if (not (rational-valued? +inf.0-0.01i)))
159 (pass-if (not (rational-valued? +0.01i)))
160 (pass-if (not (rational-valued? -inf.0i))))
162 (with-test-prefix "integer-valued?"
163 (pass-if (not (integer-valued? +nan.0)))
164 (pass-if (not (integer-valued? +nan.0+0i)))
165 (pass-if (not (integer-valued? +nan.0+0.0i)))
166 (pass-if (not (integer-valued? +inf.0)))
167 (pass-if (not (integer-valued? -inf.0)))
168 (pass-if (not (integer-valued? +inf.0+0.0i)))
169 (pass-if (not (integer-valued? -inf.0-0.0i)))
170 (pass-if (integer-valued? 3))
171 (pass-if (integer-valued? 3.0))
172 (pass-if (integer-valued? 3+0i))
173 (pass-if (integer-valued? 3+0.0i))
174 (pass-if (integer-valued? 8/4))
175 (pass-if (integer-valued? #e1e10))
176 (pass-if (integer-valued? 1e200))
177 (pass-if (integer-valued? 1e200+0.0i))
178 (pass-if (not (integer-valued? -2.5)))
179 (pass-if (not (integer-valued? -2.5+0i)))
180 (pass-if (not (integer-valued? -2.5+0.0i)))
181 (pass-if (not (integer-valued? -2.5-0i)))
182 (pass-if (not (integer-valued? 6/10)))
183 (pass-if (not (integer-valued? 6/10+0.0i)))
184 (pass-if (not (integer-valued? 6/10+0i)))
185 (pass-if (not (integer-valued? 3+i)))
186 (pass-if (not (integer-valued? -2.5+0.01i)))
187 (pass-if (not (integer-valued? +nan.0+0.01i)))
188 (pass-if (not (integer-valued? +nan.0+nan.0i)))
189 (pass-if (not (integer-valued? +inf.0-0.01i)))
190 (pass-if (not (integer-valued? +0.01i)))
191 (pass-if (not (integer-valued? -inf.0i))))
193 (with-test-prefix "assert"
194 (pass-if "assert returns value" (= 1 (assert 1)))
195 (pass-if "assertion-violation"
196 (guard (condition ((assertion-violation? condition) #t))
200 (with-test-prefix "string-for-each"
201 (pass-if "reverse string"
202 (let ((s "reverse me") (l '()))
203 (string-for-each (lambda (x) (set! l (cons x l))) s)
204 (equal? "em esrever" (list->string l))))
205 (pass-if "two strings good"
206 (let ((s1 "two legs good")
209 (string-for-each (lambda (c1 c2)
210 (set! c (cons* c2 c1 c)))
212 (equal? (list->string c)
213 "ddaobo gs gsegle lr uoowft")))
214 (pass-if "two strings bad"
217 (guard (condition ((assertion-violation? condition) #t))
218 (string-for-each (lambda (s1 s2) #f) s1 s2)
220 (pass-if "many strings good"
226 (string-for-each (lambda (c1 c2 c3 c4)
227 (set! c (cons* c4 c3 c2 c1 c)))
229 (equal? (list->string c)
231 (pass-if "many strings bad"
236 (guard (condition ((assertion-violation? condition) #t))
237 (string-for-each (lambda _ #f) s1 s2 s3 s4)