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-map!"
48 (pass-if-exception "no args" exception:wrong-num-args
51 (pass-if-exception "one arg" exception:wrong-num-args
52 (array-map! (make-array #f 5)))
54 (with-test-prefix "no sources"
57 (array-map! (make-array #f 5) (lambda () #f))
60 (pass-if-exception "closure 1" exception:wrong-num-args
61 (array-map! (make-array #f 5) (lambda (x) #f)))
63 (pass-if-exception "closure 2" exception:wrong-num-args
64 (array-map! (make-array #f 5) (lambda (x y) #f)))
66 (pass-if-exception "subr_1" exception:wrong-num-args
67 (array-map! (make-array #f 5) length))
69 (pass-if-exception "subr_2" exception:wrong-num-args
70 (array-map! (make-array #f 5) logtest))
72 (pass-if-exception "subr_2o" exception:wrong-num-args
73 (array-map! (make-array #f 5) number->string))
75 (pass-if-exception "dsubr" exception:wrong-num-args
76 (array-map! (make-array #f 5) sqrt))
79 (let ((a (make-array 'foo 5)))
81 (equal? a (make-array #t 5))))
84 (let ((a (make-array 'foo 5)))
86 (equal? a (make-array 0 5))))
88 ;; in Guile 1.6.4 and earlier this resulted in a segv
90 (array-map! (make-array #f 5) noop)
93 (with-test-prefix "one source"
95 (pass-if-exception "closure 0" exception:wrong-num-args
96 (array-map! (make-array #f 5) (lambda () #f)
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))))
104 (pass-if-exception "closure 2" exception:wrong-num-args
105 (array-map! (make-array #f 5) (lambda (x y) #f)
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))))
113 (pass-if-exception "subr_2" exception:wrong-num-args
114 (array-map! (make-array #f 5) logtest
118 (let ((a (make-array #f 5)))
119 (array-map! a number->string (make-array 99 5))
120 (equal? a (make-array "99" 5))))
123 (let ((a (make-array #f 5)))
124 (array-map! a sqrt (make-array 16.0 5))
125 (equal? a (make-array 4.0 5))))
128 (let ((a (make-array 'foo 5)))
129 (array-map! a = (make-array 0 5))
130 (equal? a (make-array #t 5))))
133 (let ((a (make-array 'foo 5)))
134 (array-map! a - (make-array 99 5))
135 (equal? a (make-array -99 5))))
137 ;; in Guile 1.6.5 and 1.6.6 this was an error
139 (let ((a (make-array #f 5)))
140 (array-map! a 1+ (make-array 123 5))
141 (equal? a (make-array 124 5)))))
143 (with-test-prefix "two sources"
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)))
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)))
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))))
159 (pass-if-exception "subr_1" exception:wrong-num-args
160 (array-map! (make-array #f 5) length
161 (make-array #f 5) (make-array #f 5)))
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))))
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))))
175 (pass-if-exception "dsubr" exception:wrong-num-args
176 (let ((a (make-array #f 5)))
178 (make-array 16.0 5) (make-array 16.0 5))
179 (equal? a (make-array 4.0 5))))
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))))
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))))
192 (let ((a (make-array #f 4)))
193 (array-map! a + #(1 2 3 4) #(5 6 7 8))
194 (equal? a #(6 8 10 12))))
196 (pass-if "noncompact arrays 1"
197 (let ((a #2((0 1) (2 3)))
200 (array-map! c + (array-row a 1) (array-row a 1))
201 (array-equal? c #(4 6)))))
203 (pass-if "noncompact arrays 2"
204 (let ((a #2((0 1) (2 3)))
207 (array-map! c + (array-col a 1) (array-col a 1))
208 (array-equal? c #(2 6)))))
210 (pass-if "noncompact arrays 3"
211 (let ((a #2((0 1) (2 3)))
214 (array-map! c + (array-col a 1) (array-row a 1))
215 (array-equal? c #(3 6)))))
217 (pass-if "noncompact arrays 4"
218 (let ((a #2((0 1) (2 3)))
221 (array-map! c + (array-col a 1) (array-row a 1))
222 (array-equal? c #(3 6)))))))
228 (with-test-prefix "array-for-each"
230 (with-test-prefix "1 source"
231 (pass-if-equal "noncompact array"
233 (let* ((a #2((0 1) (2 3)))
235 (p (lambda (x) (set! l (cons x l)))))
239 (pass-if-equal "vector"
241 (let* ((a #(0 1 2 3))
243 (p (lambda (x) (set! l (cons x l)))))
247 (pass-if-equal "shared array"
249 (let* ((a #2((0 1) (2 3)))
250 (a' (make-shared-array a
256 (p (lambda (x) (set! l (cons x l)))))
257 (array-for-each p a')
260 (with-test-prefix "3 sources"
261 (pass-if-equal "noncompact arrays 1"
263 (let* ((a #2((0 1) (2 3)))
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))
269 (pass-if-equal "noncompact arrays 2"
271 (let* ((a #2((0 1) (2 3)))
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))
277 (pass-if-equal "noncompact arrays 3"
279 (let* ((a #2((0 1) (2 3)))
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))
285 (pass-if-equal "noncompact arrays 4"
287 (let* ((a #2((0 1) (2 3)))
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))