Commit | Line | Data |
---|---|---|
66e9b24d KR |
1 | ;;;; ramap.test --- test array mapping functions -*- scheme -*- |
2 | ;;;; | |
0d7f3a6d | 3 | ;;;; Copyright (C) 2004, 2005, 2006, 2009, 2013 Free Software Foundation, Inc. |
66e9b24d KR |
4 | ;;;; |
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 | |
53befeb7 | 8 | ;;;; version 3 of the License, or (at your option) any later version. |
66e9b24d KR |
9 | ;;;; |
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. | |
14 | ;;;; | |
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 | |
92205699 | 17 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
66e9b24d KR |
18 | |
19 | (define-module (test-suite test-ramap) | |
20 | #:use-module (test-suite lib)) | |
21 | ||
848431b6 DL |
22 | (define (array-row a i) |
23 | (make-shared-array a (lambda (j) (list i j)) | |
24 | (cadr (array-dimensions a)))) | |
25 | ||
26 | (define (array-col a j) | |
27 | (make-shared-array a (lambda (i) (list i j)) | |
28 | (car (array-dimensions a)))) | |
29 | ||
ab2a10e0 KR |
30 | ;;; |
31 | ;;; array-index-map! | |
32 | ;;; | |
33 | ||
34 | (with-test-prefix "array-index-map!" | |
35 | ||
36 | (pass-if (let ((nlst '())) | |
37 | (array-index-map! (make-array #f '(1 1)) | |
38 | (lambda (n) | |
39 | (set! nlst (cons n nlst)))) | |
40 | (equal? nlst '(1))))) | |
41 | ||
66e9b24d KR |
42 | ;;; |
43 | ;;; array-map! | |
44 | ;;; | |
45 | ||
46 | (with-test-prefix "array-map!" | |
47 | ||
48 | (pass-if-exception "no args" exception:wrong-num-args | |
49 | (array-map!)) | |
50 | ||
917abf70 | 51 | (pass-if-exception "one arg" exception:wrong-num-args |
66e9b24d KR |
52 | (array-map! (make-array #f 5))) |
53 | ||
917abf70 | 54 | (with-test-prefix "no sources" |
66e9b24d | 55 | |
917abf70 KR |
56 | (pass-if "closure 0" |
57 | (array-map! (make-array #f 5) (lambda () #f)) | |
58 | #t) | |
66e9b24d | 59 | |
917abf70 KR |
60 | (pass-if-exception "closure 1" exception:wrong-num-args |
61 | (array-map! (make-array #f 5) (lambda (x) #f))) | |
62 | ||
63 | (pass-if-exception "closure 2" exception:wrong-num-args | |
64 | (array-map! (make-array #f 5) (lambda (x y) #f))) | |
65 | ||
66 | (pass-if-exception "subr_1" exception:wrong-num-args | |
67 | (array-map! (make-array #f 5) length)) | |
68 | ||
69 | (pass-if-exception "subr_2" exception:wrong-num-args | |
70 | (array-map! (make-array #f 5) logtest)) | |
71 | ||
72 | (pass-if-exception "subr_2o" exception:wrong-num-args | |
73 | (array-map! (make-array #f 5) number->string)) | |
74 | ||
75 | (pass-if-exception "dsubr" exception:wrong-num-args | |
ad79736c | 76 | (array-map! (make-array #f 5) sqrt)) |
917abf70 KR |
77 | |
78 | (pass-if "rpsubr" | |
79 | (let ((a (make-array 'foo 5))) | |
80 | (array-map! a =) | |
81 | (equal? a (make-array #t 5)))) | |
82 | ||
83 | (pass-if "asubr" | |
84 | (let ((a (make-array 'foo 5))) | |
85 | (array-map! a +) | |
86 | (equal? a (make-array 0 5)))) | |
87 | ||
88 | ;; in Guile 1.6.4 and earlier this resulted in a segv | |
89 | (pass-if "noop" | |
90 | (array-map! (make-array #f 5) noop) | |
91 | #t)) | |
92 | ||
93 | (with-test-prefix "one source" | |
94 | ||
95 | (pass-if-exception "closure 0" exception:wrong-num-args | |
96 | (array-map! (make-array #f 5) (lambda () #f) | |
97 | (make-array #f 5))) | |
98 | ||
99 | (pass-if "closure 1" | |
100 | (let ((a (make-array #f 5))) | |
101 | (array-map! a (lambda (x) 'foo) (make-array #f 5)) | |
102 | (equal? a (make-array 'foo 5)))) | |
103 | ||
104 | (pass-if-exception "closure 2" exception:wrong-num-args | |
105 | (array-map! (make-array #f 5) (lambda (x y) #f) | |
106 | (make-array #f 5))) | |
107 | ||
108 | (pass-if "subr_1" | |
109 | (let ((a (make-array #f 5))) | |
110 | (array-map! a length (make-array '(x y z) 5)) | |
111 | (equal? a (make-array 3 5)))) | |
112 | ||
113 | (pass-if-exception "subr_2" exception:wrong-num-args | |
114 | (array-map! (make-array #f 5) logtest | |
115 | (make-array 999 5))) | |
116 | ||
117 | (pass-if "subr_2o" | |
118 | (let ((a (make-array #f 5))) | |
119 | (array-map! a number->string (make-array 99 5)) | |
120 | (equal? a (make-array "99" 5)))) | |
121 | ||
122 | (pass-if "dsubr" | |
123 | (let ((a (make-array #f 5))) | |
ad79736c | 124 | (array-map! a sqrt (make-array 16.0 5)) |
917abf70 KR |
125 | (equal? a (make-array 4.0 5)))) |
126 | ||
127 | (pass-if "rpsubr" | |
128 | (let ((a (make-array 'foo 5))) | |
129 | (array-map! a = (make-array 0 5)) | |
130 | (equal? a (make-array #t 5)))) | |
131 | ||
132 | (pass-if "asubr" | |
133 | (let ((a (make-array 'foo 5))) | |
134 | (array-map! a - (make-array 99 5)) | |
135 | (equal? a (make-array -99 5)))) | |
136 | ||
137 | ;; in Guile 1.6.5 and 1.6.6 this was an error | |
138 | (pass-if "1+" | |
139 | (let ((a (make-array #f 5))) | |
140 | (array-map! a 1+ (make-array 123 5)) | |
141 | (equal? a (make-array 124 5))))) | |
142 | ||
143 | (with-test-prefix "two sources" | |
144 | ||
145 | (pass-if-exception "closure 0" exception:wrong-num-args | |
146 | (array-map! (make-array #f 5) (lambda () #f) | |
147 | (make-array #f 5) (make-array #f 5))) | |
148 | ||
149 | (pass-if-exception "closure 1" exception:wrong-num-args | |
150 | (array-map! (make-array #f 5) (lambda (x) #f) | |
151 | (make-array #f 5) (make-array #f 5))) | |
152 | ||
153 | (pass-if "closure 2" | |
154 | (let ((a (make-array #f 5))) | |
155 | (array-map! a (lambda (x y) 'foo) | |
156 | (make-array #f 5) (make-array #f 5)) | |
157 | (equal? a (make-array 'foo 5)))) | |
158 | ||
df338a22 | 159 | (pass-if-exception "subr_1" exception:wrong-num-args |
917abf70 KR |
160 | (array-map! (make-array #f 5) length |
161 | (make-array #f 5) (make-array #f 5))) | |
162 | ||
163 | (pass-if "subr_2" | |
164 | (let ((a (make-array 'foo 5))) | |
165 | (array-map! a logtest | |
166 | (make-array 999 5) (make-array 999 5)) | |
167 | (equal? a (make-array #t 5)))) | |
168 | ||
169 | (pass-if "subr_2o" | |
170 | (let ((a (make-array #f 5))) | |
171 | (array-map! a number->string | |
172 | (make-array 32 5) (make-array 16 5)) | |
173 | (equal? a (make-array "20" 5)))) | |
174 | ||
ad79736c | 175 | (pass-if-exception "dsubr" exception:wrong-num-args |
917abf70 | 176 | (let ((a (make-array #f 5))) |
ad79736c | 177 | (array-map! a sqrt |
917abf70 KR |
178 | (make-array 16.0 5) (make-array 16.0 5)) |
179 | (equal? a (make-array 4.0 5)))) | |
180 | ||
181 | (pass-if "rpsubr" | |
182 | (let ((a (make-array 'foo 5))) | |
183 | (array-map! a = (make-array 99 5) (make-array 77 5)) | |
184 | (equal? a (make-array #f 5)))) | |
185 | ||
186 | (pass-if "asubr" | |
187 | (let ((a (make-array 'foo 5))) | |
188 | (array-map! a - (make-array 99 5) (make-array 11 5)) | |
189 | (equal? a (make-array 88 5)))) | |
190 | ||
191 | (pass-if "+" | |
192 | (let ((a (make-array #f 4))) | |
193 | (array-map! a + #(1 2 3 4) #(5 6 7 8)) | |
848431b6 DL |
194 | (equal? a #(6 8 10 12)))) |
195 | ||
196 | (pass-if "noncompact arrays 1" | |
197 | (let ((a #2((0 1) (2 3))) | |
198 | (c #(0 0))) | |
199 | (begin | |
200 | (array-map! c + (array-row a 1) (array-row a 1)) | |
201 | (array-equal? c #(4 6))))) | |
202 | ||
203 | (pass-if "noncompact arrays 2" | |
204 | (let ((a #2((0 1) (2 3))) | |
205 | (c #(0 0))) | |
206 | (begin | |
207 | (array-map! c + (array-col a 1) (array-col a 1)) | |
208 | (array-equal? c #(2 6))))) | |
209 | ||
210 | (pass-if "noncompact arrays 3" | |
211 | (let ((a #2((0 1) (2 3))) | |
212 | (c #(0 0))) | |
213 | (begin | |
214 | (array-map! c + (array-col a 1) (array-row a 1)) | |
215 | (array-equal? c #(3 6))))) | |
216 | ||
217 | (pass-if "noncompact arrays 4" | |
218 | (let ((a #2((0 1) (2 3))) | |
219 | (c #(0 0))) | |
220 | (begin | |
221 | (array-map! c + (array-col a 1) (array-row a 1)) | |
222 | (array-equal? c #(3 6))))))) | |
223 | ||
224 | ;;; | |
225 | ;;; array-for-each | |
226 | ;;; | |
227 | ||
228 | (with-test-prefix "array-for-each" | |
229 | ||
3220b080 LC |
230 | (with-test-prefix "1 source" |
231 | (pass-if-equal "noncompact array" | |
232 | '(3 2 1 0) | |
233 | (let* ((a #2((0 1) (2 3))) | |
234 | (l '()) | |
235 | (p (lambda (x) (set! l (cons x l))))) | |
236 | (array-for-each p a) | |
237 | l)) | |
238 | ||
239 | (pass-if-equal "vector" | |
240 | '(3 2 1 0) | |
241 | (let* ((a #(0 1 2 3)) | |
242 | (l '()) | |
243 | (p (lambda (x) (set! l (cons x l))))) | |
244 | (array-for-each p a) | |
245 | l)) | |
246 | ||
247 | (pass-if-equal "shared array" | |
248 | '(3 2 1 0) | |
249 | (let* ((a #2((0 1) (2 3))) | |
250 | (a' (make-shared-array a | |
251 | (lambda (x) | |
252 | (list (quotient x 4) | |
253 | (modulo x 4))) | |
254 | 4)) | |
255 | (l '()) | |
256 | (p (lambda (x) (set! l (cons x l))))) | |
257 | (array-for-each p a') | |
258 | l))) | |
259 | ||
848431b6 | 260 | (with-test-prefix "3 sources" |
0d7f3a6d LC |
261 | (pass-if-equal "noncompact arrays 1" |
262 | '((3 3 3) (2 2 2)) | |
848431b6 DL |
263 | (let* ((a #2((0 1) (2 3))) |
264 | (l '()) | |
265 | (rec (lambda args (set! l (cons args l))))) | |
266 | (array-for-each rec (array-row a 1) (array-row a 1) (array-row a 1)) | |
0d7f3a6d LC |
267 | l)) |
268 | ||
269 | (pass-if-equal "noncompact arrays 2" | |
270 | '((3 3 3) (2 2 1)) | |
848431b6 DL |
271 | (let* ((a #2((0 1) (2 3))) |
272 | (l '()) | |
273 | (rec (lambda args (set! l (cons args l))))) | |
274 | (array-for-each rec (array-row a 1) (array-row a 1) (array-col a 1)) | |
0d7f3a6d LC |
275 | l)) |
276 | ||
277 | (pass-if-equal "noncompact arrays 3" | |
278 | '((3 3 3) (2 1 1)) | |
848431b6 DL |
279 | (let* ((a #2((0 1) (2 3))) |
280 | (l '()) | |
281 | (rec (lambda args (set! l (cons args l))))) | |
282 | (array-for-each rec (array-row a 1) (array-col a 1) (array-col a 1)) | |
0d7f3a6d LC |
283 | l)) |
284 | ||
285 | (pass-if-equal "noncompact arrays 4" | |
286 | '((3 2 3) (1 0 2)) | |
848431b6 DL |
287 | (let* ((a #2((0 1) (2 3))) |
288 | (l '()) | |
289 | (rec (lambda args (set! l (cons args l))))) | |
290 | (array-for-each rec (array-col a 1) (array-col a 0) (array-row a 1)) | |
0d7f3a6d | 291 | l)))) |