source: project/release/5/arrays/tags/1.0/tests/run.scm @ 37416

Last change on this file since 37416 was 37416, checked in by juergen, 21 months ago

arrays ported from chicken-4

File size: 7.8 KB
Line 
1(require-library arrays)
2(import array-handlers arrays array-sets simple-tests
3        (chicken random) (chicken fixnum))
4
5(define arr (make-array number?))
6(define copied (make-array number?));(array-copy arr))
7(define arr0 (array 0))
8(define arr1 (make-array number?))
9(define rar (make-array number?))
10
11(define-test (arrays?)
12  (array? arr)
13  (array-null? arr)
14  (not (array? (array-handler arr)))
15  (zero? (array-length arr))
16  (do ((k 0 (fx+ k 1)))
17    ((fx= k 15))
18    (array-add! k arr))
19  (not (array-null? arr))
20  (= (array-length arr) 15)
21  (= (array-length (array-range 2 10 arr)) 8)
22  (array-equ? = arr (array-iterate number? 15 add1 0))
23  (= (array-item 0 arr) 0)
24  (= (array-item 10 arr) 10)
25  (= (array-item 14 arr) 14)
26  (equal? (array->list (array-range 5 10 arr))
27          '(5 6 7 8 9))
28  (equal? (array->vector (array-take 5 arr))
29          '#(0 1 2 3 4))
30  (array-eqv? (array-copy (array-drop 10 arr))
31              (array number? 10 11 12 13 14))
32  (array-eq? (array-repeat 5 #f) (array #f #f #f #f #f))
33  (array-eqv? (array-iterate-while (cut < <> 5) add1 0)
34              (array-iterate 5 add1 0))
35  (array-eqv? (array-iterate-until (cut = <> 5) add1 0)
36              (list->array '(0 1 2 3 4)))
37  (array-eqv? (array-copy (array-range 5 10 arr))
38              (array number? 5 6 7 8 9))
39  (equal? (array->vector (array-map add1 (array-range 3 6 arr)))
40          '#(4 5 6))
41  (array-eqv?  (array-map number? + (array number? 1 2) (array number?  10 20 30))
42               (array number? 11 22))
43  (array-eqv? (array-append (array-range 2 5 arr)
44                            (array-range 10 12 arr)
45                            (array-range 13 14 arr))
46              (array number? 2 3 4 10 11 13))
47
48  (set! copied (array-copy arr))   ;;;;;
49  (array-reverse! copied)
50  (array-eqv? copied (array number? 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0))
51  (array-eqv? copied (array-reverse arr))
52  (array-cursor-start! arr)
53  (array-cursor-goto! (cut = <> 5) arr)
54  (= (array-cursor-item arr) 5)
55  (array-cursor-goto! (cut = <> 5) arr)
56  (array-cursor-finished? arr)
57  (array-reverse! copied)
58  (= (let ((arr-5-10 (array-range 5 10 copied)))
59       (array-cursor-start! arr-5-10)
60       (array-cursor-next! arr-5-10)
61       (array-cursor-item arr-5-10))
62     5)
63  (array-prune! arr)
64  (array-eqv? arr (array-take 14 copied))
65  (array-add! 14 arr)
66  (array-eqv? arr copied)
67  (array-prune! arr0)
68  (array-null? arr0)
69  (do ((k 15 (fx+ k 1)))
70    ((fx= k 20))
71    (array-add! k arr1))
72  (array-append! arr1
73                 (array number? 20 21)
74                 (array number? 22))
75  (array-eqv? arr1 (array-iterate number? 8 add1 15))
76  (equal?
77    (receive (ar0 ar1) (array-filter odd? arr)
78      (list (array->vector ar0) (array->vector ar1)))
79    '(#(1 3 5 7 9 11 13) #(0 2 4 6 8 10 12 14)))
80  (array-eqv? (array-range 3 8 arr)
81              (array-iterate number? 5 add1 3))
82  (equal?
83    (receive (ar0 ar1) (array-split-with (cut <= <> 5) arr)
84      (list (array->list ar0) (array->list ar1)))
85    '((0 1 2 3 4 5) (6 7 8 9 10 11 12 13 14)))
86  (array-eqv? (array-take-while (cut <= <> 5) arr)
87              (array number? 0 1 2 3 4 5))
88  (array-eqv? (array-drop-while (cut <= <> 5) arr)
89              (array number? 6 7 8 9 10 11 12 13 14))
90  (= (array-fold-left * 1 arr1) (* 15 16 17 18 19 20 21 22))
91  (equal? (array-fold-left cons '() (array-take 5 arr1))
92          '(((((() . 15) . 16) . 17) . 18) . 19))
93  (equal? (array-fold-right cons '() arr1)
94          '(15 16 17 18 19 20 21 22))
95  (= (array-fold-left + 0 (array 1 2 3) (array 10 20 30)) 66)
96  (array-eqv? (array-reverse arr) (array-iterate number? 15 sub1 14))
97  (array-eqv? (array-reverse (array-range 5 10 arr))
98              (array-iterate number? 5 sub1 9))
99  (array-sorted? < arr)
100  (not (array-sorted? < (array 1 3 2 4 5 7)))
101  (do ((n 0 (fx+ n 1)))
102    ((fx= n 100))
103    (array-add! (pseudo-random-integer 1000) rar))
104  (array-sort! < rar)
105  (array-sorted? <= rar)
106  "note that (array-sorted? < rar) is probably wrong because of dups"
107  (= (array-apply + 1 2 (array number? 3 4 5)) 15)
108  (equal?  (array-bind (a b . xs) arr (list a b (array->vector xs)))
109           (list 0 1 (vector 2 3 4 5 6 7 8 9 10 11 12 13 14)))
110  (array-eqv? (array-mappend (lambda x (apply array number? x))
111                             (array number? 1 2)
112                             (array number? 10 20 30))
113              (array number? 1 10 2 20))
114  (array-eqv? (array-mappend (lambda x (apply array x))
115                             (array 0 2 4)
116                             (array 1 3 5 7 9))
117              (array 0 1 2 3 4 5))
118  (array-eqv? (array-zip (array 0 2 4) (array 1 3 5 7 9))
119              (array 0 1 2 3 4 5 7 9))
120  (equal?
121    (receive (ar0 ar1) (array-unzip arr)
122      (list (array->list ar0) (array->list ar1)))
123    '((0 2 4 6 8 10 12 14) (1 3 5 7 9 11 13)))
124  (array-eqv? (array 1 2 3) (array 1 2 3) (array 1 2 3))
125  (not (array-eqv? (array 1 2 3) (array 1 2 3 4)))
126  "different item types:"
127  (not (array-eqv? (array number? 1 2 3) (array 1 2 3)))
128  (array-eqv? (array-interpose 100 (array-range 5 10 arr))
129              (array number? 5 100 6 100 7 100 8 100 9))
130  (array-every? odd? (array 1 5 7))
131  (not (array-every? odd? (array 1 4 7)))
132  (array-some? odd? (array 2 3 5))
133  (not (array-some? odd? (array 2 4 6)))
134  (array-cursor-start! arr)
135  (array-cursor-goto! (cut = <> 5) arr)
136  (= (array-cursor-item arr) 5)
137  (array-eqv? (array-memv 10 arr) (array number? 10 11 12 13 14))
138  (not (array-memv 20 arr))
139  (array-in? = (array 2 3) (array 1 2 3))
140  (not (array-in? = (array 1 2 3) (array 2 3)))
141  (not (array-in? = (array 1 2 3) (array 2 1 3)))
142  (array-equ? = (array-range 5 10 arr) (array number? 5 6 7 8 9))
143  (array-eqv? (array-remv 5 arr)
144              (array number? 0 1 2 3 4 6 7 8 9 10 11 12 13 14))
145  (array-eqv? (array-take-while even? arr) (array number? 0))
146  (array-eqv? (array-drop-while even? arr)
147              (array number? 1 2 3 4 5 6 7 8 9 10 11 12 13 14))
148  (array-eqv? (array-filter even? arr)
149              (array number? 0 2 4 6 8 10 12 14))
150  (array-eqv? (array-remove-dups = (array 1 2 1 3 2 4 3 5))
151              (array 1 2 3 4 5))
152  )
153
154(define st (make-set =))
155
156(define-test (sets?)
157  (set? st)
158  (set-null? st)
159  (not (set-in 5 st))
160  (set-add! 5 st)
161  (set-in 5 st)
162  (set-add! 2 st)
163  (= (set-count st) 2)
164  (set-in 2 st)
165  (set-add! 2 st)
166  (= (set-count st) 2)
167  (equal? (set->vector st) '#(5 2))
168  (equal? (set->list st) '(5 2))
169  (do ((k 0 (+ k 1)))
170    ((= k 5) st)
171    (set-add! k st))
172  (set-in 3 st)
173  (set-remove! 5 st)
174  (set= st (set = 0 1 2 3 4))
175  (set-remove! 10 st)
176  (set= st (set = 0 1 2 3 4))
177  (set= (set-iterate = 10 add1 0)
178        (set = 0 1 2 3 4 5 6 7 8 9))
179  (set= (set-iterate-while = (cut < <> 10) add1 0)
180        (set = 0 1 2 3 4 5 6 7 8 9))
181  (set= (set-iterate-until = (cut = <> 10) add1 0)
182        (set = 0 1 2 3 4 5 6 7 8 9))
183  (list->set = '(0 1 2 3 4))
184  (vector->set '#(0 1 2 3 4))
185  (set<= (set 1 3 2) (set 0 1 2 3 4))
186  (not (set<= (set = 1 3 2) (set 0 1 2 3 4)))
187  (not (set<= (set 1 3 2 5) (set 0 1 2 3 4)))
188  (set= (set 1 3 2 1 2) (set 1 2 3))
189  (set= (set-filter odd? (set 0 1 2 3 4 5 6))
190        (set 1 3 5))
191  (set= (set-map + (set 1 2 3 4) (set 10 20 30))
192        (set 11 22 33))
193  (set= (set-copy (set 1 2 3 2 1 2)) (set 1 2 3))
194  (set= (set-difference (set 1 2 3 2 1 2) (set 1 5 6 2))
195        (set 3))
196  (set= (set-union (set 1 3 2 1) (set 10 20 10) (set 200 100 200 300))
197        (set 1 2 3 10 20 100 200 300))
198  (set= (set-intersection (set 0 1 2 3 4 5) (set 7 9 1 3 5))
199        (set 1 3 5))
200  (set= (set-intersection (set 0 1 2 3 4 5) (set 7 9 1 3 5) (set 1 3))
201        (set 1 3))
202  (set-every? odd? (set 1 3 5 7))
203  (set-every? odd? (make-set))
204  (not (set-every? odd? (set 1 3 5 4 7)))
205  (not (set-some? odd? (make-set)))
206  (not (set-some? odd? (set 2 4 6 8 10)))
207  (set-some? odd? (set 2 4 6 8 7 10))
208  (= (set-apply + 1 2 3 (set 4 5)) 15)
209  )
210
211(compound-test (ARRAYS-AND-SETS)
212  (arrays?)
213  (sets?)
214  )
215
216
Note: See TracBrowser for help on using the repository browser.