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