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