1 ;;;; vlist.test --- VLists. -*- mode: scheme; coding: utf-8; -*-
3 ;;;; Ludovic Courtès <ludo@gnu.org>
5 ;;;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc.
7 ;;;; This library is free software; you can redistribute it and/or
8 ;;;; modify it under the terms of the GNU Lesser General Public
9 ;;;; License as published by the Free Software Foundation; either
10 ;;;; version 3 of the License, or (at your option) any later version.
12 ;;;; This library is distributed in the hope that it will be useful,
13 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 ;;;; Lesser General Public License for more details.
17 ;;;; You should have received a copy of the GNU Lesser General Public
18 ;;;; License along with this library; if not, write to the Free Software
19 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
21 (define-module (test-vlist)
22 #:use-module (test-suite lib)
23 #:use-module (ice-9 vlist)
24 #:use-module (srfi srfi-1)
25 #:use-module (srfi srfi-26))
32 (with-test-prefix "vlist"
35 (and (vlist? vlist-null)
36 (vlist? (vlist-cons 'a vlist-null))))
38 (pass-if "vlist-null?"
39 (vlist-null? vlist-null))
42 (let* ((v1 (vlist-cons 1 vlist-null))
43 (v2 (vlist-cons 2 v1))
44 (v3 (vlist-cons 3 v2))
45 (v4 (vlist-cons 4 v3)))
46 (every vlist? (list v1 v2 v3 v4))))
49 (let* ((v1 (vlist-cons 1 vlist-null))
50 (v2 (vlist-cons 2 v1))
51 (v3 (vlist-cons 3 v2))
52 (v4 (vlist-cons 4 v3)))
53 (equal? (map vlist-head (list v1 v2 v3 v4))
57 (let* ((v1 (vlist-cons 1 vlist-null))
58 (v2 (vlist-cons 2 v1))
59 (v3 (vlist-cons 3 v2))
60 (v4 (vlist-cons 4 v3)))
61 (equal? (map vlist-head
62 (map vlist-tail (list v2 v3 v4)))
65 (pass-if "vlist->list"
66 (let* ((v1 (vlist-cons 1 vlist-null))
67 (v2 (vlist-cons 2 v1))
68 (v3 (vlist-cons 3 v2))
69 (v4 (vlist-cons 4 v3)))
73 (pass-if "list->vlist"
74 (equal? (vlist->list (list->vlist '(1 2 3 4 5)))
78 (equal? (vlist->list (vlist-drop (list->vlist (iota 77)) 7))
81 (pass-if "vlist-cons2"
82 ;; Example from Bagwell's paper, Figure 2.
83 (let* ((top (list->vlist '(8 7 6 5 4 3)))
84 (part (vlist-tail (vlist-tail top)))
85 (test (vlist-cons 9 part)))
86 (equal? (vlist->list test)
89 (pass-if "vlist-cons3"
90 (let ((vlst (vlist-cons 'a
92 (vlist-drop (list->vlist (iota 5))
94 (equal? (vlist->list vlst)
98 (equal? (vlist->list (vlist-map 1+ (list->vlist '(1 2 3 4 5))))
101 (pass-if "vlist-length"
102 (= (vlist-length (list->vlist (iota 77)))
105 (pass-if "vlist-length complex"
106 (= (vlist-length (fold vlist-cons
107 (vlist-drop (list->vlist (iota 77)) 33)
112 (let* ((indices (iota 111))
113 (vlst (list->vlist indices)))
114 (equal? (map (lambda (i)
119 (pass-if "vlist-ref degenerate"
120 ;; Degenerate case where VLST contains only 1-element blocks.
121 (let* ((indices (iota 111))
122 (vlst (fold (lambda (i vl)
123 (let ((vl (vlist-cons 'x vl)))
124 (vlist-cons i (vlist-tail vl))))
127 (equal? (map (lambda (i)
132 (pass-if "vlist-filter"
133 (let* ((lst (iota 33))
134 (vlst (fold-right vlist-cons vlist-null lst)))
135 (equal? (vlist->list (vlist-filter even? vlst))
136 (filter even? lst))))
138 (pass-if "vlist-delete"
139 (let* ((lst '(a b c d e))
140 (vlst (fold-right vlist-cons vlist-null lst)))
141 (equal? (vlist->list (vlist-delete 'c vlst))
144 (pass-if "vlist-take"
145 (let* ((lst (iota 77))
146 (vlst (fold-right vlist-cons vlist-null lst)))
147 (equal? (vlist->list (vlist-take vlst 44))
150 (pass-if "vlist-unfold"
151 (let ((results (map (lambda (unfold)
152 (unfold (lambda (i) (> i 100))
156 (list unfold vlist-unfold))))
157 (equal? (car results)
158 (vlist->list (cadr results)))))
160 (pass-if "vlist-append"
161 (let* ((lists '((a) (b c) (d e f) (g)))
162 (vlst (apply vlist-append (map list->vlist lists)))
163 (lst (apply append lists)))
164 (equal? lst (vlist->list vlst)))))
171 (with-test-prefix "vhash"
174 (vhash? (vhash-cons "hello" "world" vlist-null)))
176 (pass-if "vhash-assoc vlist-null"
177 (not (vhash-assq 'a vlist-null)))
179 (pass-if "vhash-assoc simple"
180 (let ((vh (vhash-cons "hello" "world" vlist-null)))
181 (equal? (cons "hello" "world")
182 (vhash-assoc "hello" vh))))
184 (pass-if "vhash-assoc regular"
185 (let* ((keys '(a b c d e f g h i))
186 (values '(1 2 3 4 5 6 7 8 9))
187 (vh (fold vhash-cons vlist-null keys values)))
188 (fold (lambda (k v result)
191 (vhash-assoc k vh eq?))))
196 (pass-if "vhash-assoc tail"
197 (let* ((keys '(a b c d e f g h i))
198 (values '(1 2 3 4 5 6 7 8 9))
199 (vh1 (fold vhash-consq vlist-null keys values))
200 (vh2 (vhash-consq 'x 'x (vlist-tail vh1))))
201 (and (fold (lambda (k v result)
204 (vhash-assq k vh2))))
206 (cons 'x (delq 'i keys))
207 (cons 'x (delv 9 values)))
208 (not (vhash-assq 'i vh2)))))
210 (pass-if "vhash-assoc degenerate"
211 (let* ((keys '(a b c d e f g h i))
212 (values '(1 2 3 4 5 6 7 8 9))
213 (vh (fold (lambda (k v vh)
214 ;; Degenerate case where VH2 contains only
216 (let* ((vh1 (vhash-cons 'x 'x vh))
217 (vh2 (vlist-tail vh1)))
218 (vhash-cons k v vh2)))
219 vlist-null keys values)))
220 (and (fold (lambda (k v result)
227 (not (vhash-assq 'x vh)))))
229 (pass-if "vhash as vlist"
230 (let* ((keys '(a b c d e f g h i))
231 (values '(1 2 3 4 5 6 7 8 9))
232 (vh (fold vhash-cons vlist-null keys values))
233 (alist (fold alist-cons '() keys values)))
234 (and (equal? (vlist->list vh) alist)
235 (= (length alist) (vlist-length vh))
236 (fold (lambda (i result)
238 (equal? (list-ref alist i)
241 (iota (vlist-length vh))))))
243 (pass-if "vhash entry shadowed"
244 (let* ((a (vhash-consq 'a 1 vlist-null))
245 (b (vhash-consq 'a 2 a)))
246 (and (= 1 (cdr (vhash-assq 'a a)))
247 (= 2 (cdr (vhash-assq 'a b)))
248 (= 1 (cdr (vhash-assq 'a (vlist-tail b)))))))
250 (pass-if "vlist-filter"
251 (let* ((keys '(a b c d e f g h i))
252 (values '(1 2 3 4 5 6 7 8 9))
253 (vh (fold vhash-cons vlist-null keys values))
254 (alist (fold alist-cons '() keys values))
259 (let ((vh (vlist-filter pred vh))
260 (alist (filter pred alist)))
261 (and (equal? (vlist->list vh) alist)
262 (= (length alist) (vlist-length vh))
263 (fold (lambda (i result)
265 (equal? (list-ref alist i)
268 (iota (vlist-length vh)))))))
270 (pass-if "vhash-delete"
271 (let* ((keys '(a b c d e f g d h i))
272 (values '(1 2 3 4 5 6 7 0 8 9))
273 (vh (fold vhash-cons vlist-null keys values))
274 (alist (fold alist-cons '() keys values)))
275 (let ((vh (vhash-delete 'd vh))
276 (alist (alist-delete 'd alist)))
277 (and (= (length alist) (vlist-length vh))
278 (fold (lambda (k result)
280 (equal? (assq k alist)
281 (vhash-assoc k vh eq?))))
285 (pass-if "vhash-delete honors HASH"
286 ;; In 2.0.0, `vhash-delete' would construct a new vhash without
287 ;; using the supplied hash procedure, which could lead to
290 (vh (fold vhash-consq
291 (vhash-consq s "world" vlist-null)
294 (and (vhash-assq s vh)
295 (pair? (vhash-assq s (vhash-delete 123 vh eq? hashq))))))
297 (pass-if "vhash-fold"
298 (let* ((keys '(a b c d e f g d h i))
299 (values '(1 2 3 4 5 6 7 0 8 9))
300 (vh (fold vhash-cons vlist-null keys values))
301 (alist (fold alist-cons '() keys values)))
302 (equal? alist (reverse (vhash-fold alist-cons '() vh)))))
304 (pass-if "vhash-fold-right"
305 (let* ((keys '(a b c d e f g d h i))
306 (values '(1 2 3 4 5 6 7 0 8 9))
307 (vh (fold vhash-cons vlist-null keys values))
308 (alist (fold alist-cons '() keys values)))
309 (equal? alist (vhash-fold-right alist-cons '() vh))))
311 (pass-if "alist->vhash"
312 (let* ((keys '(a b c d e f g d h i))
313 (values '(1 2 3 4 5 6 7 0 8 9))
314 (alist (fold alist-cons '() keys values))
315 (vh (alist->vhash alist))
316 (alist2 (vlist-fold cons '() vh)))
317 (and (equal? alist (reverse alist2))
318 (fold (lambda (k result)
320 (equal? (assq k alist)
321 (vhash-assoc k vh eq?))))
325 (pass-if "vhash-fold*"
326 (let* ((keys (make-list 10 'a))
328 (vh (fold vhash-cons vlist-null keys values)))
329 (equal? (vhash-fold* cons '() 'a vh)
332 (pass-if "vhash-fold* tail"
333 (let* ((keys (make-list 100 'a))
335 (vh (fold vhash-cons vlist-null keys values)))
336 (equal? (vhash-fold* cons '() 'a (vlist-drop vh 42))
337 (take values (- 100 42)))))
339 (pass-if "vhash-fold* interleaved"
340 (let* ((keys '(a b a b a b a b a b c d e a b))
341 (values '(1 0 2 0 3 0 4 0 5 0 0 0 0 6 0))
342 (vh (fold vhash-cons vlist-null keys values)))
343 (equal? (vhash-fold* cons '() 'a vh)
344 (filter (cut > <> 0) values))))
346 (pass-if "vhash-foldq* degenerate"
347 (let* ((keys '(a b a b a a a b a b a a a z))
348 (values '(1 0 2 0 3 4 5 0 6 0 7 8 9 0))
349 (vh (fold (lambda (k v vh)
350 ;; Degenerate case where VH2 contains only
352 (let* ((vh1 (vhash-consq 'x 'x vh))
353 (vh2 (vlist-tail vh1)))
354 (vhash-consq k v vh2)))
355 vlist-null keys values)))
356 (equal? (vhash-foldq* cons '() 'a vh)
357 (filter (cut > <> 0) values)))))