~peter-pearse/ubuntu/natty/guile-1.8/prop001

« back to all changes in this revision

Viewing changes to test-suite/tests/srfi-4.test

  • Committer: Bazaar Package Importer
  • Author(s): Daniel Schepler
  • Date: 2006-11-09 03:11:16 UTC
  • Revision ID: james.westby@ubuntu.com-20061109031116-hu0q1jxqg12y6yeg
Tags: upstream-1.8.1+1
ImportĀ upstreamĀ versionĀ 1.8.1+1

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
;;;; srfi-4.test --- Test suite for Guile's SRFI-4 functions. -*- scheme -*-
 
2
;;;; Martin Grabmueller, 2001-06-26
 
3
;;;;
 
4
;;;; Copyright (C) 2001, 2006 Free Software Foundation, Inc.
 
5
;;;; 
 
6
;;;; This program is free software; you can redistribute it and/or modify
 
7
;;;; it under the terms of the GNU General Public License as published by
 
8
;;;; the Free Software Foundation; either version 2, or (at your option)
 
9
;;;; any later version.
 
10
;;;; 
 
11
;;;; This program is distributed in the hope that it will be useful,
 
12
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 
13
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
14
;;;; GNU General Public License for more details.
 
15
;;;; 
 
16
;;;; You should have received a copy of the GNU General Public License
 
17
;;;; along with this software; see the file COPYING.  If not, write to
 
18
;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 
19
;;;; Boston, MA 02110-1301 USA
 
20
 
 
21
(use-modules (srfi srfi-4)
 
22
             (test-suite lib))
 
23
 
 
24
(with-test-prefix "u8 vectors"
 
25
 
 
26
  (pass-if "u8vector? success"
 
27
    (u8vector? (u8vector)))
 
28
 
 
29
  (pass-if "u8vector? failure"
 
30
    (not (u8vector? (s8vector))))
 
31
 
 
32
  (pass-if "u8vector-length success 1"
 
33
    (= (u8vector-length (u8vector)) 0))
 
34
 
 
35
  (pass-if "u8vector-length success 2"
 
36
    (= (u8vector-length (u8vector 3)) 1))
 
37
 
 
38
  (pass-if "u8vector-length failure"
 
39
    (not (= (u8vector-length (u8vector 3)) 3)))
 
40
 
 
41
  (pass-if "u8vector-ref"
 
42
    (= (u8vector-ref (u8vector 1 2 3) 1) 2))
 
43
  
 
44
  (pass-if "u8vector-set!/ref"
 
45
    (= (let ((s (make-u8vector 10 0)))
 
46
         (u8vector-set! s 4 33)
 
47
         (u8vector-ref s 4)) 33))
 
48
 
 
49
  (pass-if "u8vector->list/list->u8vector"
 
50
    (equal? (u8vector->list (u8vector 1 2 3 4))
 
51
            (u8vector->list (list->u8vector '(1 2 3 4))))))
 
52
 
 
53
(with-test-prefix "s8 vectors"
 
54
 
 
55
  (pass-if "s8vector? success"
 
56
    (s8vector? (s8vector)))
 
57
 
 
58
  (pass-if "s8vector? failure"
 
59
    (not (s8vector? (u8vector))))
 
60
 
 
61
  (pass-if "s8vector-length success 1"
 
62
    (= (s8vector-length (s8vector)) 0))
 
63
 
 
64
  (pass-if "s8vector-length success 2"
 
65
    (= (s8vector-length (s8vector -3)) 1))
 
66
 
 
67
  (pass-if "s8vector-length failure"
 
68
    (not (= (s8vector-length (s8vector 3)) 3)))
 
69
 
 
70
  (pass-if "s8vector-ref"
 
71
    (= (s8vector-ref (s8vector 1 2 3) 1) 2))
 
72
  
 
73
  (pass-if "s8vector-set!/ref"
 
74
    (= (let ((s (make-s8vector 10 0)))
 
75
         (s8vector-set! s 4 33)
 
76
         (s8vector-ref s 4)) 33))
 
77
 
 
78
  (pass-if "s8vector->list/list->s8vector"
 
79
    (equal? (s8vector->list (s8vector 1 2 3 4))
 
80
            (s8vector->list (list->s8vector '(1 2 3 4))))))
 
81
 
 
82
 
 
83
(with-test-prefix "u16 vectors"
 
84
 
 
85
  (pass-if "u16vector? success"
 
86
    (u16vector? (u16vector)))
 
87
 
 
88
  (pass-if "u16vector? failure"
 
89
    (not (u16vector? (s16vector))))
 
90
 
 
91
  (pass-if "u16vector-length success 1"
 
92
    (= (u16vector-length (u16vector)) 0))
 
93
 
 
94
  (pass-if "u16vector-length success 2"
 
95
    (= (u16vector-length (u16vector 3)) 1))
 
96
 
 
97
  (pass-if "u16vector-length failure"
 
98
    (not (= (u16vector-length (u16vector 3)) 3)))
 
99
 
 
100
  (pass-if "u16vector-ref"
 
101
    (= (u16vector-ref (u16vector 1 2 3) 1) 2))
 
102
  
 
103
  (pass-if "u16vector-set!/ref"
 
104
    (= (let ((s (make-u16vector 10 0)))
 
105
         (u16vector-set! s 4 33)
 
106
         (u16vector-ref s 4)) 33))
 
107
 
 
108
  (pass-if "u16vector->list/list->u16vector"
 
109
    (equal? (u16vector->list (u16vector 1 2 3 4))
 
110
            (u16vector->list (list->u16vector '(1 2 3 4))))))
 
111
 
 
112
(with-test-prefix "s16 vectors"
 
113
 
 
114
  (pass-if "s16vector? success"
 
115
    (s16vector? (s16vector)))
 
116
 
 
117
  (pass-if "s16vector? failure"
 
118
    (not (s16vector? (u16vector))))
 
119
 
 
120
  (pass-if "s16vector-length success 1"
 
121
    (= (s16vector-length (s16vector)) 0))
 
122
 
 
123
  (pass-if "s16vector-length success 2"
 
124
    (= (s16vector-length (s16vector -3)) 1))
 
125
 
 
126
  (pass-if "s16vector-length failure"
 
127
    (not (= (s16vector-length (s16vector 3)) 3)))
 
128
 
 
129
  (pass-if "s16vector-ref"
 
130
    (= (s16vector-ref (s16vector 1 2 3) 1) 2))
 
131
  
 
132
  (pass-if "s16vector-set!/ref"
 
133
    (= (let ((s (make-s16vector 10 0)))
 
134
         (s16vector-set! s 4 33)
 
135
         (s16vector-ref s 4)) 33))
 
136
 
 
137
  (pass-if "s16vector->list/list->s16vector"
 
138
    (equal? (s16vector->list (s16vector 1 2 3 4))
 
139
            (s16vector->list (list->s16vector '(1 2 3 4))))))
 
140
 
 
141
(with-test-prefix "u32 vectors"
 
142
 
 
143
  (pass-if "u32vector? success"
 
144
    (u32vector? (u32vector)))
 
145
 
 
146
  (pass-if "u32vector? failure"
 
147
    (not (u32vector? (s32vector))))
 
148
 
 
149
  (pass-if "u32vector-length success 1"
 
150
    (= (u32vector-length (u32vector)) 0))
 
151
 
 
152
  (pass-if "u32vector-length success 2"
 
153
    (= (u32vector-length (u32vector 3)) 1))
 
154
 
 
155
  (pass-if "u32vector-length failure"
 
156
    (not (= (u32vector-length (u32vector 3)) 3)))
 
157
 
 
158
  (pass-if "u32vector-ref"
 
159
    (= (u32vector-ref (u32vector 1 2 3) 1) 2))
 
160
  
 
161
  (pass-if "u32vector-set!/ref"
 
162
    (= (let ((s (make-u32vector 10 0)))
 
163
         (u32vector-set! s 4 33)
 
164
         (u32vector-ref s 4)) 33))
 
165
 
 
166
  (pass-if "u32vector->list/list->u32vector"
 
167
    (equal? (u32vector->list (u32vector 1 2 3 4))
 
168
            (u32vector->list (list->u32vector '(1 2 3 4))))))
 
169
 
 
170
(with-test-prefix "s32 vectors"
 
171
 
 
172
  (pass-if "s32vector? success"
 
173
    (s32vector? (s32vector)))
 
174
 
 
175
  (pass-if "s32vector? failure"
 
176
    (not (s32vector? (u32vector))))
 
177
 
 
178
  (pass-if "s32vector-length success 1"
 
179
    (= (s32vector-length (s32vector)) 0))
 
180
 
 
181
  (pass-if "s32vector-length success 2"
 
182
    (= (s32vector-length (s32vector -3)) 1))
 
183
 
 
184
  (pass-if "s32vector-length failure"
 
185
    (not (= (s32vector-length (s32vector 3)) 3)))
 
186
 
 
187
  (pass-if "s32vector-ref"
 
188
    (= (s32vector-ref (s32vector 1 2 3) 1) 2))
 
189
  
 
190
  (pass-if "s32vector-set!/ref"
 
191
    (= (let ((s (make-s32vector 10 0)))
 
192
         (s32vector-set! s 4 33)
 
193
         (s32vector-ref s 4)) 33))
 
194
 
 
195
  (pass-if "s32vector->list/list->s32vector"
 
196
    (equal? (s32vector->list (s32vector 1 2 3 4))
 
197
            (s32vector->list (list->s32vector '(1 2 3 4))))))
 
198
 
 
199
(with-test-prefix "u64 vectors"
 
200
 
 
201
  (pass-if "u64vector? success"
 
202
    (u64vector? (u64vector)))
 
203
 
 
204
  (pass-if "u64vector? failure"
 
205
    (not (u64vector? (s64vector))))
 
206
 
 
207
  (pass-if "u64vector-length success 1"
 
208
    (= (u64vector-length (u64vector)) 0))
 
209
 
 
210
  (pass-if "u64vector-length success 2"
 
211
    (= (u64vector-length (u64vector 3)) 1))
 
212
 
 
213
  (pass-if "u64vector-length failure"
 
214
    (not (= (u64vector-length (u64vector 3)) 3)))
 
215
 
 
216
  (pass-if "u64vector-ref"
 
217
    (= (u64vector-ref (u64vector 1 2 3) 1) 2))
 
218
  
 
219
  (pass-if "u64vector-set!/ref"
 
220
    (= (let ((s (make-u64vector 10 0)))
 
221
         (u64vector-set! s 4 33)
 
222
         (u64vector-ref s 4)) 33))
 
223
 
 
224
  (pass-if "u64vector->list/list->u64vector"
 
225
    (equal? (u64vector->list (u64vector 1 2 3 4))
 
226
            (u64vector->list (list->u64vector '(1 2 3 4))))))
 
227
 
 
228
(with-test-prefix "s64 vectors"
 
229
 
 
230
  (pass-if "s64vector? success"
 
231
    (s64vector? (s64vector)))
 
232
 
 
233
  (pass-if "s64vector? failure"
 
234
    (not (s64vector? (u64vector))))
 
235
 
 
236
  (pass-if "s64vector-length success 1"
 
237
    (= (s64vector-length (s64vector)) 0))
 
238
 
 
239
  (pass-if "s64vector-length success 2"
 
240
    (= (s64vector-length (s64vector -3)) 1))
 
241
 
 
242
  (pass-if "s64vector-length failure"
 
243
    (not (= (s64vector-length (s64vector 3)) 3)))
 
244
 
 
245
  (pass-if "s64vector-ref"
 
246
    (= (s64vector-ref (s64vector 1 2 3) 1) 2))
 
247
  
 
248
  (pass-if "s64vector-set!/ref"
 
249
    (= (let ((s (make-s64vector 10 0)))
 
250
         (s64vector-set! s 4 33)
 
251
         (s64vector-ref s 4)) 33))
 
252
 
 
253
  (pass-if "s64vector->list/list->s64vector"
 
254
    (equal? (s64vector->list (s64vector 1 2 3 4))
 
255
            (s64vector->list (list->s64vector '(1 2 3 4))))))
 
256
 
 
257
(with-test-prefix "f32 vectors"
 
258
 
 
259
  (pass-if "f32vector? success"
 
260
    (f32vector? (f32vector)))
 
261
 
 
262
  (pass-if "f32vector? failure"
 
263
    (not (f32vector? (s8vector))))
 
264
 
 
265
  (pass-if "f32vector-length success 1"
 
266
    (= (f32vector-length (f32vector)) 0))
 
267
 
 
268
  (pass-if "f32vector-length success 2"
 
269
    (= (f32vector-length (f32vector -3)) 1))
 
270
 
 
271
  (pass-if "f32vector-length failure"
 
272
    (not (= (f32vector-length (f32vector 3)) 3)))
 
273
 
 
274
  (pass-if "f32vector-ref"
 
275
    (= (f32vector-ref (f32vector 1 2 3) 1) 2))
 
276
  
 
277
  (pass-if "f32vector-set!/ref"
 
278
    (= (let ((s (make-f32vector 10 0)))
 
279
         (f32vector-set! s 4 33)
 
280
         (f32vector-ref s 4)) 33))
 
281
 
 
282
  (pass-if "f32vector->list/list->f32vector"
 
283
    (equal? (f32vector->list (f32vector 1 2 3 4))
 
284
            (f32vector->list (list->f32vector '(1 2 3 4))))))
 
285
 
 
286
(with-test-prefix "f64 vectors"
 
287
 
 
288
  (pass-if "f64vector? success"
 
289
    (f64vector? (f64vector)))
 
290
 
 
291
  (pass-if "f64vector? failure"
 
292
    (not (f64vector? (f32vector))))
 
293
 
 
294
  (pass-if "f64vector-length success 1"
 
295
    (= (f64vector-length (f64vector)) 0))
 
296
 
 
297
  (pass-if "f64vector-length success 2"
 
298
    (= (f64vector-length (f64vector -3)) 1))
 
299
 
 
300
  (pass-if "f64vector-length failure"
 
301
    (not (= (f64vector-length (f64vector 3)) 3)))
 
302
 
 
303
  (pass-if "f64vector-ref"
 
304
    (= (f64vector-ref (f64vector 1 2 3) 1) 2))
 
305
  
 
306
  (pass-if "f64vector-set!/ref"
 
307
    (= (let ((s (make-f64vector 10 0)))
 
308
         (f64vector-set! s 4 33)
 
309
         (f64vector-ref s 4)) 33))
 
310
 
 
311
  (pass-if "f64vector->list/list->f64vector"
 
312
    (equal? (f64vector->list (f64vector 1 2 3 4))
 
313
            (f64vector->list (list->f64vector '(1 2 3 4))))))