/[guile]/guile/guile-core/test-suite/tests/srfi-1.test
ViewVC logotype

Diff of /guile/guile-core/test-suite/tests/srfi-1.test

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.8 by kryde, Sat Aug 30 00:02:44 2003 UTC revision 1.9 by kryde, Tue Dec 2 21:17:33 2003 UTC
# Line 85  Line 85 
85    (with-test-prefix "concatenate!"    (with-test-prefix "concatenate!"
86      (common-tests concatenate! #f)))      (common-tests concatenate! #f)))
87    
88    ;;
89    ;; count
90    ;;
91    
92    (with-test-prefix "count"
93      (pass-if-exception "no args" exception:wrong-num-args
94        (count))
95      
96      (pass-if-exception "one arg" exception:wrong-num-args
97        (count noop))
98      
99      (with-test-prefix "one list"
100        (define (or1 x)
101          x)
102        
103        (pass-if "empty list" (= 0 (count or1 '())))
104        
105        (pass-if-exception "pred arg count 0" exception:wrong-type-arg
106          (count (lambda () x) '(1 2 3)))
107        (pass-if-exception "pred arg count 2" exception:wrong-type-arg
108          (count (lambda (x y) x) '(1 2 3)))
109        
110        (pass-if-exception "improper 1" exception:wrong-type-arg
111          (count or1 1))
112        (pass-if-exception "improper 2" exception:wrong-type-arg
113          (count or1 '(1 . 2)))
114        (pass-if-exception "improper 3" exception:wrong-type-arg
115          (count or1 '(1 2 . 3)))
116        
117        (pass-if (= 0 (count or1 '(#f))))
118        (pass-if (= 1 (count or1 '(#t))))
119        
120        (pass-if (= 0 (count or1 '(#f #f))))
121        (pass-if (= 1 (count or1 '(#f #t))))
122        (pass-if (= 1 (count or1 '(#t #f))))
123        (pass-if (= 2 (count or1 '(#t #t))))
124        
125        (pass-if (= 0 (count or1 '(#f #f #f))))
126        (pass-if (= 1 (count or1 '(#f #f #t))))
127        (pass-if (= 1 (count or1 '(#t #f #f))))
128        (pass-if (= 2 (count or1 '(#t #f #t))))
129        (pass-if (= 3 (count or1 '(#t #t #t)))))
130      
131      (with-test-prefix "two lists"
132        (define (or2 x y)
133          (or x y))
134        
135        (pass-if "arg order"
136          (= 1 (count (lambda (x y)
137                        (and (= 1 x)
138                             (= 2 y)))
139                      '(1) '(2))))
140        
141        (pass-if "empty lists" (= 0 (count or2 '() '())))
142        
143        (pass-if-exception "pred arg count 0" exception:wrong-type-arg
144          (count (lambda () #t) '(1 2 3) '(1 2 3)))
145        (pass-if-exception "pred arg count 1" exception:wrong-type-arg
146          (count (lambda (x) x) '(1 2 3) '(1 2 3)))
147        (pass-if-exception "pred arg count 3" exception:wrong-type-arg
148          (count (lambda (x y z) x) '(1 2 3) '(1 2 3)))
149        
150        (pass-if-exception "improper first 1" exception:wrong-type-arg
151          (count or2 1 '(1 2 3)))
152        (pass-if-exception "improper first 2" exception:wrong-type-arg
153          (count or2 '(1 . 2) '(1 2 3)))
154        (pass-if-exception "improper first 3" exception:wrong-type-arg
155          (count or2 '(1 2 . 3) '(1 2 3)))
156        
157        (pass-if-exception "improper second 1" exception:wrong-type-arg
158          (count or2 '(1 2 3) 1))
159        (pass-if-exception "improper second 2" exception:wrong-type-arg
160          (count or2 '(1 2 3) '(1 . 2)))
161        (pass-if-exception "improper second 3" exception:wrong-type-arg
162          (count or2 '(1 2 3) '(1 2 . 3)))
163        
164        (pass-if (= 0 (count or2 '(#f) '(#f))))
165        (pass-if (= 1 (count or2 '(#t) '(#f))))
166        (pass-if (= 1 (count or2 '(#f) '(#t))))
167        
168        (pass-if (= 0 (count or2 '(#f #f) '(#f #f))))
169        (pass-if (= 1 (count or2 '(#t #f) '(#t #f))))
170        (pass-if (= 2 (count or2 '(#t #t) '(#f #f))))
171        (pass-if (= 2 (count or2 '(#t #f) '(#f #t))))
172        
173        (with-test-prefix "stop shortest"
174          (pass-if (= 2 (count or2 '(#t #f #t) '(#f #t))))
175          (pass-if (= 2 (count or2 '(#t #f #t #t) '(#f #t))))
176          (pass-if (= 2 (count or2 '(#t #f) '(#f #t #t))))
177          (pass-if (= 2 (count or2 '(#t #f) '(#f #t #t #t))))))
178      
179      (with-test-prefix "three lists"
180        (define (or3 x y z)
181          (or x y z))
182        
183        (pass-if "arg order"
184          (= 1 (count (lambda (x y z)
185                        (and (= 1 x)
186                             (= 2 y)
187                             (= 3 z)))
188                      '(1) '(2) '(3))))
189        
190        (pass-if "empty lists" (= 0 (count or3 '() '() '())))
191        
192        ;; currently bad pred argument gives wrong-num-args when 3 or more
193        ;; lists, as opposed to wrong-type-arg for 1 or 2 lists
194        (pass-if-exception "pred arg count 0" exception:wrong-num-args
195          (count (lambda () #t) '(1 2 3) '(1 2 3) '(1 2 3)))
196        (pass-if-exception "pred arg count 2" exception:wrong-num-args
197          (count (lambda (x y) x) '(1 2 3) '(1 2 3)'(1 2 3) ))
198        (pass-if-exception "pred arg count 4" exception:wrong-num-args
199          (count (lambda (w x y z) x) '(1 2 3) '(1 2 3) '(1 2 3)))
200        
201        (pass-if-exception "improper first 1" exception:wrong-type-arg
202          (count or3 1 '(1 2 3) '(1 2 3)))
203        (pass-if-exception "improper first 2" exception:wrong-type-arg
204          (count or3 '(1 . 2) '(1 2 3) '(1 2 3)))
205        (pass-if-exception "improper first 3" exception:wrong-type-arg
206          (count or3 '(1 2 . 3) '(1 2 3) '(1 2 3)))
207        
208        (pass-if-exception "improper second 1" exception:wrong-type-arg
209          (count or3 '(1 2 3) 1 '(1 2 3)))
210        (pass-if-exception "improper second 2" exception:wrong-type-arg
211          (count or3 '(1 2 3) '(1 . 2) '(1 2 3)))
212        (pass-if-exception "improper second 3" exception:wrong-type-arg
213          (count or3 '(1 2 3) '(1 2 . 3) '(1 2 3)))
214        
215        (pass-if-exception "improper third 1" exception:wrong-type-arg
216          (count or3 '(1 2 3) '(1 2 3) 1))
217        (pass-if-exception "improper third 2" exception:wrong-type-arg
218          (count or3 '(1 2 3) '(1 2 3) '(1 . 2)))
219        (pass-if-exception "improper third 3" exception:wrong-type-arg
220          (count or3 '(1 2 3) '(1 2 3) '(1 2 . 3)))
221        
222        (pass-if (= 0 (count or3 '(#f) '(#f) '(#f))))
223        (pass-if (= 1 (count or3 '(#t) '(#f) '(#f))))
224        (pass-if (= 1 (count or3 '(#f) '(#t) '(#f))))
225        (pass-if (= 1 (count or3 '(#f) '(#f) '(#t))))
226        
227        (pass-if (= 0 (count or3 '(#f #f) '(#f #f) '(#f #f))))
228        
229        (pass-if (= 1 (count or3 '(#t #f) '(#f #f) '(#f #f))))
230        (pass-if (= 1 (count or3 '(#f #t) '(#f #f) '(#f #f))))
231        (pass-if (= 1 (count or3 '(#f #f) '(#t #f) '(#f #f))))
232        (pass-if (= 1 (count or3 '(#f #f) '(#f #t) '(#f #f))))
233        (pass-if (= 1 (count or3 '(#f #f) '(#f #f) '(#t #f))))
234        (pass-if (= 1 (count or3 '(#f #f) '(#f #f) '(#f #t))))
235        
236        (pass-if (= 2 (count or3 '(#t #t) '(#f #f) '(#f #f))))
237        (pass-if (= 2 (count or3 '(#f #f) '(#t #t) '(#f #f))))
238        (pass-if (= 2 (count or3 '(#f #f) '(#f #f) '(#t #t))))
239        (pass-if (= 2 (count or3 '(#f #f) '(#t #f) '(#f #t))))
240        
241        (with-test-prefix "stop shortest"
242          (pass-if (= 0 (count or3 '() '(#t #t #t) '(#t #t))))
243          (pass-if (= 0 (count or3 '(#t #t #t) '() '(#t #t))))
244          (pass-if (= 0 (count or3 '(#t #t #t) '(#t #t) '())))
245          
246          (pass-if (= 1 (count or3 '(#t) '(#t #t #t) '(#t #t))))
247          (pass-if (= 1 (count or3 '(#t #t #t) '(#t) '(#t #t))))
248          (pass-if (= 1 (count or3 '(#t #t #t) '(#t #t) '(#t)))))))
249    
250  ;;  ;;
251  ;; delete and delete!  ;; delete and delete!

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26