1;;;; ramap.test --- test array mapping functions -*- scheme -*-
2;;;;
3;;;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc.
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
17;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
18
19(define-module (test-suite test-ramap)
20  #:use-module (test-suite lib))
21
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
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
43  (pass-if-exception "one arg" exception:wrong-num-args
44    (array-map! (make-array #f 5)))
45
46  (with-test-prefix "no sources"
47
48    (pass-if "closure 0"
49      (array-map! (make-array #f 5) (lambda () #f))
50      #t)
51
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))))))
187