source: project/release/5/queues/trunk/tests/run.scm @ 34718

Last change on this file since 34718 was 34718, checked in by sjamaan, 18 months ago

release/5: Replace use by import in eggs

File size: 3.5 KB
Line 
1(import queues)
2
3(define-syntax assert-error
4  (syntax-rules ()
5    ((_ expr)
6     (assert (handle-exceptions _ #t expr #f)))))
7
8;; Queues.
9
10;; These are tested extensively (and probably still not enough)
11;; because of the strange dealings with the front and end lists stored
12;; internally.  If we run into errors, add more regression tests here.
13
14(let ((q (make-queue)))
15  (assert (queue? q))
16  (assert (queue-empty? q))
17  (assert (= 0 (queue-length q)))
18  (assert (null? (queue->list q)))
19  (assert-error (queue-first q))
20  (assert-error (queue-last q))
21  (assert-error (queue-remove! q))
22
23  (queue-add! q 'foo)
24  (assert (eq? 'foo (queue-first q)))
25  (assert (eq? 'foo (queue-last q)))
26  (assert (not (queue-empty? q)))
27  (assert (= (queue-length q) 1))
28  (let ((l1 (queue->list q))
29        (l2 (queue->list q)))
30    (assert (equal? l1 '(foo)))
31    (assert (equal? l2 '(foo)))
32    (assert (not (eq? l1 l2)))          ; Do not share memory
33
34    (queue-add! q 'end)
35
36    (queue-push-back! q 'front)
37
38    (assert (equal? l1 '(foo))))      ; Does not share memory w/ queue
39  (assert (equal? (queue->list q) '(front foo end)))
40
41  (assert (eq? 'front (queue-remove! q)))
42  (assert (eq? 'foo (queue-first q)))
43  (assert (eq? 'end (queue-last q)))
44
45  (queue-push-back-list! q '(one two))
46  (assert (equal? (queue->list q) '(one two foo end)))
47  (assert (= 4 (queue-length q)))
48
49  (assert (eq? 'one (queue-remove! q)))
50  (assert (eq? 'two (queue-remove! q)))
51  (assert (= 2 (queue-length q)))
52  (assert (eq? 'foo (queue-first q)))
53  (assert (eq? 'end (queue-last q)))
54  (assert (not (queue-empty? q)))
55
56  (assert (eq? 'foo (queue-remove! q)))
57  (assert (eq? 'end (queue-first q)))
58  (assert (eq? 'end (queue-last q)))
59  (assert (= (queue-length q) 1))
60  (assert (not (queue-empty? q)))
61
62  (assert (eq? 'end (queue-remove! q)))
63  (assert (queue-empty? q))
64  (assert (= (queue-length q) 0))
65  (assert-error (queue-first q))
66  (assert-error (queue-last q))
67  (assert-error (queue-remove! q)))
68
69(let ((q (list->queue (list 'one 'two))))
70  (assert (queue? q))
71  (assert (not (queue-empty? q)))
72  (assert (= (queue-length q) 2))
73  (assert (eq? 'one (queue-first q)))
74  (assert (eq? 'two (queue-last q)))
75
76  (assert (eq? 'one (queue-remove! q)))
77  (assert (eq? 'two (queue-first q)))
78  (assert (eq? 'two (queue-last q)))
79  (assert (= (queue-length q) 1))
80  (assert (not (queue-empty? q)))
81
82  (assert (eq? 'two (queue-remove! q)))
83  (assert-error (queue-first q))
84  (assert-error (queue-last q))
85  (assert (= (queue-length q) 0))
86  (assert (queue-empty? q)))
87
88(let ((q (list->queue (list 'one))))
89  (assert (queue? q))
90  (assert (not (queue-empty? q)))
91  (assert (= (queue-length q) 1))
92  (assert (eq? 'one (queue-first q)))
93  (assert (eq? 'one (queue-last q)))
94
95  (queue-push-back! q 'zero)
96  (assert (eq? 'zero (queue-first q)))
97  (assert (eq? 'one (queue-last q)))
98
99  (queue-add! q 'two)
100  (assert (eq? 'zero (queue-first q)))
101  (assert (eq? 'two (queue-last q)))
102
103  (queue-add! q 'three)
104  (assert (eq? 'zero (queue-first q)))
105  (assert (eq? 'three (queue-last q)))
106  (assert (equal? '(zero one two three) (queue->list q)))
107
108  (assert (eq? 'zero (queue-remove! q)))
109  (assert (eq? 'one (queue-first q)))
110  (assert (eq? 'three (queue-last q)))
111  (assert (= (queue-length q) 3))
112  (assert (not (queue-empty? q)))
113
114  (assert (eq? 'one (queue-remove! q)))
115  (assert (eq? 'two (queue-remove! q)))
116  (assert (eq? 'three (queue-remove! q)))
117  (assert-error (queue-first q))
118  (assert-error (queue-last q))
119  (assert (= (queue-length q) 0))
120  (assert (queue-empty? q)))
Note: See TracBrowser for help on using the repository browser.