1 ;;;; ramap.test --- test array mapping functions -*- scheme -*-
3 ;;;; Copyright (C) 2004, 2005, 2006, 2009, 2013 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
19 (define-module (test-suite test-ramap)
20 #:use-module (test-suite lib))
22 (define (array-row a i)
23 (make-shared-array a (lambda (j) (list i j))
24 (cadr (array-dimensions a))))
26 (define (array-col a j)
27 (make-shared-array a (lambda (i) (list i j))
28 (car (array-dimensions a))))
34 (with-test-prefix "array-index-map!"
36 (pass-if (let ((nlst '()))
37 (array-index-map! (make-array #f '(1 1))
39 (set! nlst (cons n nlst))))
46 (with-test-prefix "array-copy!"
48 (pass-if "empty arrays"
49 (let* ((b (make-array 0 2 2))
50 (c (make-shared-array b (lambda (i j) (list i j)) 0 2)))
51 (array-copy! #2:0:2() c)
52 (array-equal? #2:0:2() c))))
58 (with-test-prefix "array-map!"
60 (pass-if-exception "no args" exception:wrong-num-args
63 (pass-if-exception "one arg" exception:wrong-num-args
64 (array-map! (make-array #f 5)))
66 (with-test-prefix "no sources"
69 (array-map! (make-array #f 5) (lambda () #f))
72 (pass-if-exception "closure 1" exception:wrong-num-args
73 (array-map! (make-array #f 5) (lambda (x) #f)))
75 (pass-if-exception "closure 2" exception:wrong-num-args
76 (array-map! (make-array #f 5) (lambda (x y) #f)))
78 (pass-if-exception "subr_1" exception:wrong-num-args
79 (array-map! (make-array #f 5) length))
81 (pass-if-exception "subr_2" exception:wrong-num-args
82 (array-map! (make-array #f 5) logtest))
84 (pass-if-exception "subr_2o" exception:wrong-num-args
85 (array-map! (make-array #f 5) number->string))
87 (pass-if-exception "dsubr" exception:wrong-num-args
88 (array-map! (make-array #f 5) sqrt))
91 (let ((a (make-array 'foo 5)))
93 (equal? a (make-array #t 5))))
96 (let ((a (make-array 'foo 5)))
98 (equal? a (make-array 0 5))))
100 ;; in Guile 1.6.4 and earlier this resulted in a segv
102 (array-map! (make-array #f 5) noop)
105 (with-test-prefix "one source"
107 (pass-if-exception "closure 0" exception:wrong-num-args
108 (array-map! (make-array #f 5) (lambda () #f)
112 (let ((a (make-array #f 5)))
113 (array-map! a (lambda (x) 'foo) (make-array #f 5))
114 (equal? a (make-array 'foo 5))))
116 (pass-if-exception "closure 2" exception:wrong-num-args
117 (array-map! (make-array #f 5) (lambda (x y) #f)
121 (let ((a (make-array #f 5)))
122 (array-map! a length (make-array '(x y z) 5))
123 (equal? a (make-array 3 5))))
125 (pass-if-exception "subr_2" exception:wrong-num-args
126 (array-map! (make-array #f 5) logtest
130 (let ((a (make-array #f 5)))
131 (array-map! a number->string (make-array 99 5))
132 (equal? a (make-array "99" 5))))
135 (let ((a (make-array #f 5)))
136 (array-map! a sqrt (make-array 16.0 5))
137 (equal? a (make-array 4.0 5))))
140 (let ((a (make-array 'foo 5)))
141 (array-map! a = (make-array 0 5))
142 (equal? a (make-array #t 5))))
145 (let ((a (make-array 'foo 5)))
146 (array-map! a - (make-array 99 5))
147 (equal? a (make-array -99 5))))
149 ;; in Guile 1.6.5 and 1.6.6 this was an error
151 (let ((a (make-array #f 5)))
152 (array-map! a 1+ (make-array 123 5))
153 (equal? a (make-array 124 5)))))
155 (with-test-prefix "two sources"
157 (pass-if-exception "closure 0" exception:wrong-num-args
158 (array-map! (make-array #f 5) (lambda () #f)
159 (make-array #f 5) (make-array #f 5)))
161 (pass-if-exception "closure 1" exception:wrong-num-args
162 (array-map! (make-array #f 5) (lambda (x) #f)
163 (make-array #f 5) (make-array #f 5)))
166 (let ((a (make-array #f 5)))
167 (array-map! a (lambda (x y) 'foo)
168 (make-array #f 5) (make-array #f 5))
169 (equal? a (make-array 'foo 5))))
171 (pass-if-exception "subr_1" exception:wrong-num-args
172 (array-map! (make-array #f 5) length
173 (make-array #f 5) (make-array #f 5)))
176 (let ((a (make-array 'foo 5)))
177 (array-map! a logtest
178 (make-array 999 5) (make-array 999 5))
179 (equal? a (make-array #t 5))))
182 (let ((a (make-array #f 5)))
183 (array-map! a number->string
184 (make-array 32 5) (make-array 16 5))
185 (equal? a (make-array "20" 5))))
187 (pass-if-exception "dsubr" exception:wrong-num-args
188 (let ((a (make-array #f 5)))
190 (make-array 16.0 5) (make-array 16.0 5))
191 (equal? a (make-array 4.0 5))))
194 (let ((a (make-array 'foo 5)))
195 (array-map! a = (make-array 99 5) (make-array 77 5))
196 (equal? a (make-array #f 5))))
199 (let ((a (make-array 'foo 5)))
200 (array-map! a - (make-array 99 5) (make-array 11 5))
201 (equal? a (make-array 88 5))))
204 (let ((a (make-array #f 4)))
205 (array-map! a + #(1 2 3 4) #(5 6 7 8))
206 (equal? a #(6 8 10 12))))
208 (pass-if "noncompact arrays 1"
209 (let ((a #2((0 1) (2 3)))
210 (c (make-array 0 2)))
212 (array-map! c + (array-row a 1) (array-row a 1))
213 (array-equal? c #(4 6)))))
215 (pass-if "noncompact arrays 2"
216 (let ((a #2((0 1) (2 3)))
217 (c (make-array 0 2)))
219 (array-map! c + (array-col a 1) (array-col a 1))
220 (array-equal? c #(2 6)))))
222 (pass-if "noncompact arrays 3"
223 (let ((a #2((0 1) (2 3)))
224 (c (make-array 0 2)))
226 (array-map! c + (array-col a 1) (array-row a 1))
227 (array-equal? c #(3 6)))))
229 (pass-if "noncompact arrays 4"
230 (let ((a #2((0 1) (2 3)))
231 (c (make-array 0 2)))
233 (array-map! c + (array-col a 1) (array-row a 1))
234 (array-equal? c #(3 6)))))))
240 (with-test-prefix "array-for-each"
242 (with-test-prefix "1 source"
243 (pass-if-equal "noncompact array"
245 (let* ((a #2((0 1) (2 3)))
247 (p (lambda (x) (set! l (cons x l)))))
251 (pass-if-equal "vector"
253 (let* ((a #(0 1 2 3))
255 (p (lambda (x) (set! l (cons x l)))))
259 (pass-if-equal "shared array"
261 (let* ((a #2((0 1) (2 3)))
262 (a' (make-shared-array a
268 (p (lambda (x) (set! l (cons x l)))))
269 (array-for-each p a')
272 (with-test-prefix "3 sources"
273 (pass-if-equal "noncompact arrays 1"
275 (let* ((a #2((0 1) (2 3)))
277 (rec (lambda args (set! l (cons args l)))))
278 (array-for-each rec (array-row a 1) (array-row a 1) (array-row a 1))
281 (pass-if-equal "noncompact arrays 2"
283 (let* ((a #2((0 1) (2 3)))
285 (rec (lambda args (set! l (cons args l)))))
286 (array-for-each rec (array-row a 1) (array-row a 1) (array-col a 1))
289 (pass-if-equal "noncompact arrays 3"
291 (let* ((a #2((0 1) (2 3)))
293 (rec (lambda args (set! l (cons args l)))))
294 (array-for-each rec (array-row a 1) (array-col a 1) (array-col a 1))
297 (pass-if-equal "noncompact arrays 4"
299 (let* ((a #2((0 1) (2 3)))
301 (rec (lambda args (set! l (cons args l)))))
302 (array-for-each rec (array-col a 1) (array-col a 0) (array-row a 1))