File: list-queues.sps

package info (click to toggle)
chez-srfi 0.0%2Bgit20241031.b424440%2Bdfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 3,608 kB
  • sloc: lisp: 25,299; sh: 326; makefile: 11
file content (99 lines) | stat: -rw-r--r-- 3,596 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
; Reference SRFI-117 tests ported from (chibi test) to (srfi :64 testing).
; Using SRFI-64 test-group gave some trouble hence using test-begin/test-end.

(import
  (rnrs)
  (srfi private define-values)
  (srfi :64 testing)
  (srfi :117 list-queues))

(test-begin "list-queues/simple")
  (test-equal '(1 1 1) (list-queue-list (make-list-queue '(1 1 1))))
  (define x (list-queue 1 2 3))
  (test-equal '(1 2 3) (list-queue-list x))
  (define x1 (list 1 2 3))
  (define x2 (make-list-queue x1 (cddr x1)))
  (test-equal 3 (list-queue-back x2))
  (define y (list-queue 4 5))
  (test-assert (list-queue? y))
  (define z (list-queue-append x y))
  (test-equal '(1 2 3 4 5) (list-queue-list z))
  (define z2 (list-queue-append! x (list-queue-copy y)))
  (test-equal '(1 2 3 4 5) (list-queue-list z2))
  (test-equal 1 (list-queue-front z))
  (test-equal 5 (list-queue-back z))
  (list-queue-remove-front! y)
  (test-equal '(5) (list-queue-list y))
  (list-queue-remove-back! y)
  (test-assert (list-queue-empty? y))
  (test-error (list-queue-remove-front! y))
  (test-error (list-queue-remove-back! y))
  (test-equal '(1 2 3 4 5) (list-queue-list z))
  (test-equal '(1 2 3 4 5) (list-queue-remove-all! z2))
  (test-assert (list-queue-empty? z2))
  (list-queue-remove-all! z)
  (list-queue-add-front! z 1)
  (list-queue-add-front! z 0)
  (list-queue-add-back! z 2)
  (list-queue-add-back! z 3)
  (test-equal '(0 1 2 3) (list-queue-list z))
(test-end "list-queues/simple")

(test-begin "list-queues/whole")
  (define a (list-queue 1 2 3))
  (define b (list-queue-copy a))
  (test-equal '(1 2 3) (list-queue-list b))
  (list-queue-add-front! b 0)
  (test-equal '(1 2 3) (list-queue-list a))
  (test-equal 4 (length (list-queue-list b)))
  (define c (list-queue-concatenate (list a b)))
  (test-equal '(1 2 3 0 1 2 3) (list-queue-list c))
(test-end "list-queues/whole")

(test-begin "list-queues/map")
  (define r (list-queue 1 2 3))
  (define s (list-queue-map (lambda (x) (* x 10)) r))
  (test-equal '(10 20 30) (list-queue-list s))
  (list-queue-map! (lambda (x) (+ x 1)) r)
  (test-equal '(2 3 4) (list-queue-list r))
  (define sum 0)
  (list-queue-for-each (lambda (x) (set! sum (+ sum x))) s)
  (test-equal 60 sum)
(test-end "list-queues/map")

(test-begin "list-queues/conversion")
  (define n (list-queue 5 6))
  (list-queue-set-list! n (list 1 2))
  (test-equal '(1 2) (list-queue-list n))
  (define d (list 1 2 3))
  (define e (cddr d))
  (define f (make-list-queue d e))
  (define-values (dx ex) (list-queue-first-last f))
  (test-assert (eq? d dx))
  (test-assert (eq? e ex))
  (test-equal '(1 2 3) (list-queue-list f))
  (list-queue-add-front! f 0)
  (list-queue-add-back! f 4)
  (test-equal '(0 1 2 3 4) (list-queue-list f))
  (define g (make-list-queue d e))
  (test-equal '(1 2 3 4) (list-queue-list g))
  (define h (list-queue 5 6))
  (list-queue-set-list! h d e)
  (test-equal '(1 2 3 4) (list-queue-list h))
(test-end "list-queues/conversion")

(test-begin "list-queues/unfold")
  (define (double x) (* x 2))
  (define (done? x) (> x 3))
  (define (add1 x) (+ x 1))
  (define xx (list-queue-unfold done? double add1 0))
  (test-equal '(0 2 4 6) (list-queue-list xx))
  (define yy (list-queue-unfold-right done? double add1 0))
  (test-equal '(6 4 2 0) (list-queue-list yy))
  (define xx0 (list-queue 8))
  (define xx1 (list-queue-unfold done? double add1 0 xx0))
  (test-equal '(0 2 4 6 8) (list-queue-list xx1))
  (define yy0 (list-queue 8))
  (define yy1 (list-queue-unfold-right done? double add1 0 yy0))
  (test-equal '(8 6 4 2 0) (list-queue-list yy1))
(test-end "list-queues/unfold")