Commit | Line | Data |
---|---|---|
66e9b24d KR |
1 | ;;;; ramap.test --- test array mapping functions -*- scheme -*- |
2 | ;;;; | |
6e7d5622 | 3 | ;;;; Copyright (C) 2004, 2005, 2006 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 | ||
ab2a10e0 KR |
22 | ;;; |
23 | ;;; array-index-map! | |
24 | ;;; | |
25 | ||
26 | (with-test-prefix "array-index-map!" | |
27 | ||
28 | (pass-if (let ((nlst '())) | |
29 | (array-index-map! (make-array #f '(1 1)) | |
30 | (lambda (n) | |
31 | (set! nlst (cons n nlst)))) | |
32 | (equal? nlst '(1))))) | |
33 | ||
66e9b24d KR |
34 | ;;; |
35 | ;;; array-map! | |
36 | ;;; | |
37 | ||
38 | (with-test-prefix "array-map!" | |
39 | ||
40 | (pass-if-exception "no args" exception:wrong-num-args | |
41 | (array-map!)) | |
42 | ||
917abf70 | 43 | (pass-if-exception "one arg" exception:wrong-num-args |
66e9b24d KR |
44 | (array-map! (make-array #f 5))) |
45 | ||
917abf70 | 46 | (with-test-prefix "no sources" |
66e9b24d | 47 | |
917abf70 KR |
48 | (pass-if "closure 0" |
49 | (array-map! (make-array #f 5) (lambda () #f)) | |
50 | #t) | |
66e9b24d | 51 | |
917abf70 KR |
52 | (pass-if-exception "closure 1" exception:wrong-num-args |
53 | (array-map! (make-array #f 5) (lambda (x) #f))) | |
54 | ||
55 | (pass-if-exception "closure 2" exception:wrong-num-args | |
56 | (array-map! (make-array #f 5) (lambda (x y) #f))) | |
57 | ||
58 | (pass-if-exception "subr_1" exception:wrong-num-args | |
59 | (array-map! (make-array #f 5) length)) | |
60 | ||
61 | (pass-if-exception "subr_2" exception:wrong-num-args | |
62 | (array-map! (make-array #f 5) logtest)) | |
63 | ||
64 | (pass-if-exception "subr_2o" exception:wrong-num-args | |
65 | (array-map! (make-array #f 5) number->string)) | |
66 | ||
67 | (pass-if-exception "dsubr" exception:wrong-num-args | |
68 | (array-map! (make-array #f 5) $sqrt)) | |
69 | ||
70 | (pass-if "rpsubr" | |
71 | (let ((a (make-array 'foo 5))) | |
72 | (array-map! a =) | |
73 | (equal? a (make-array #t 5)))) | |
74 | ||
75 | (pass-if "asubr" | |
76 | (let ((a (make-array 'foo 5))) | |
77 | (array-map! a +) | |
78 | (equal? a (make-array 0 5)))) | |
79 | ||
80 | ;; in Guile 1.6.4 and earlier this resulted in a segv | |
81 | (pass-if "noop" | |
82 | (array-map! (make-array #f 5) noop) | |
83 | #t)) | |
84 | ||
85 | (with-test-prefix "one source" | |
86 | ||
87 | (pass-if-exception "closure 0" exception:wrong-num-args | |
88 | (array-map! (make-array #f 5) (lambda () #f) | |
89 | (make-array #f 5))) | |
90 | ||
91 | (pass-if "closure 1" | |
92 | (let ((a (make-array #f 5))) | |
93 | (array-map! a (lambda (x) 'foo) (make-array #f 5)) | |
94 | (equal? a (make-array 'foo 5)))) | |
95 | ||
96 | (pass-if-exception "closure 2" exception:wrong-num-args | |
97 | (array-map! (make-array #f 5) (lambda (x y) #f) | |
98 | (make-array #f 5))) | |
99 | ||
100 | (pass-if "subr_1" | |
101 | (let ((a (make-array #f 5))) | |
102 | (array-map! a length (make-array '(x y z) 5)) | |
103 | (equal? a (make-array 3 5)))) | |
104 | ||
105 | (pass-if-exception "subr_2" exception:wrong-num-args | |
106 | (array-map! (make-array #f 5) logtest | |
107 | (make-array 999 5))) | |
108 | ||
109 | (pass-if "subr_2o" | |
110 | (let ((a (make-array #f 5))) | |
111 | (array-map! a number->string (make-array 99 5)) | |
112 | (equal? a (make-array "99" 5)))) | |
113 | ||
114 | (pass-if "dsubr" | |
115 | (let ((a (make-array #f 5))) | |
116 | (array-map! a $sqrt (make-array 16.0 5)) | |
117 | (equal? a (make-array 4.0 5)))) | |
118 | ||
119 | (pass-if "rpsubr" | |
120 | (let ((a (make-array 'foo 5))) | |
121 | (array-map! a = (make-array 0 5)) | |
122 | (equal? a (make-array #t 5)))) | |
123 | ||
124 | (pass-if "asubr" | |
125 | (let ((a (make-array 'foo 5))) | |
126 | (array-map! a - (make-array 99 5)) | |
127 | (equal? a (make-array -99 5)))) | |
128 | ||
129 | ;; in Guile 1.6.5 and 1.6.6 this was an error | |
130 | (pass-if "1+" | |
131 | (let ((a (make-array #f 5))) | |
132 | (array-map! a 1+ (make-array 123 5)) | |
133 | (equal? a (make-array 124 5))))) | |
134 | ||
135 | (with-test-prefix "two sources" | |
136 | ||
137 | (pass-if-exception "closure 0" exception:wrong-num-args | |
138 | (array-map! (make-array #f 5) (lambda () #f) | |
139 | (make-array #f 5) (make-array #f 5))) | |
140 | ||
141 | (pass-if-exception "closure 1" exception:wrong-num-args | |
142 | (array-map! (make-array #f 5) (lambda (x) #f) | |
143 | (make-array #f 5) (make-array #f 5))) | |
144 | ||
145 | (pass-if "closure 2" | |
146 | (let ((a (make-array #f 5))) | |
147 | (array-map! a (lambda (x y) 'foo) | |
148 | (make-array #f 5) (make-array #f 5)) | |
149 | (equal? a (make-array 'foo 5)))) | |
150 | ||
151 | (pass-if-exception "subr_1" exception:wrong-type-arg | |
152 | (array-map! (make-array #f 5) length | |
153 | (make-array #f 5) (make-array #f 5))) | |
154 | ||
155 | (pass-if "subr_2" | |
156 | (let ((a (make-array 'foo 5))) | |
157 | (array-map! a logtest | |
158 | (make-array 999 5) (make-array 999 5)) | |
159 | (equal? a (make-array #t 5)))) | |
160 | ||
161 | (pass-if "subr_2o" | |
162 | (let ((a (make-array #f 5))) | |
163 | (array-map! a number->string | |
164 | (make-array 32 5) (make-array 16 5)) | |
165 | (equal? a (make-array "20" 5)))) | |
166 | ||
167 | (pass-if "dsubr" | |
168 | (let ((a (make-array #f 5))) | |
169 | (array-map! a $sqrt | |
170 | (make-array 16.0 5) (make-array 16.0 5)) | |
171 | (equal? a (make-array 4.0 5)))) | |
172 | ||
173 | (pass-if "rpsubr" | |
174 | (let ((a (make-array 'foo 5))) | |
175 | (array-map! a = (make-array 99 5) (make-array 77 5)) | |
176 | (equal? a (make-array #f 5)))) | |
177 | ||
178 | (pass-if "asubr" | |
179 | (let ((a (make-array 'foo 5))) | |
180 | (array-map! a - (make-array 99 5) (make-array 11 5)) | |
181 | (equal? a (make-array 88 5)))) | |
182 | ||
183 | (pass-if "+" | |
184 | (let ((a (make-array #f 4))) | |
185 | (array-map! a + #(1 2 3 4) #(5 6 7 8)) | |
186 | (equal? a #(6 8 10 12)))))) |