5 (define-module (tests test-core)
6 #:use-module (srfi srfi-64)
8 #:use-module (ice-9 receive)
9 #:use-module (loopy agenda))
17 (test-assert (time-= '(1 . 1) '(1 . 1)))
18 (test-assert (not (time-= '(1 . 1) '(1 . 0))))
19 (test-assert (not (time-= '(0 . 1) '(1 . 1))))
21 (test-assert (time-< '(1 . 1) '(1 . 2)))
22 (test-assert (time-< '(7 . 2) '(8 . 2)))
23 (test-assert (not (time-< '(7 . 2) '(7 . 2))))
24 (test-assert (not (time-< '(7 . 8) '(7 . 2))))
25 (test-assert (not (time-< '(8 . 2) '(7 . 2))))
33 (define (assert-times-expected time-segments expected-times)
34 (test-equal (map time-segment-time time-segments)
37 (define a-proc (const 'a))
38 (define b-proc (const 'b))
39 (define c-proc (const 'c))
40 (define d-proc (const 'd))
41 (define e-proc (const 'e))
42 (define f-proc (const 'f))
44 (define sched (make-schedule))
45 (test-assert (schedule-empty? sched))
47 ;; Add a segment at (10 . 0)
48 (schedule-add! 10 a-proc sched)
49 (test-assert (not (schedule-empty? sched)))
50 (test-equal (length (schedule-segments sched)) 1)
51 (test-equal (time-segment-time (car (schedule-segments sched)))
53 (test-equal (q-length (time-segment-queue (car (schedule-segments sched))))
55 (test-eq (q-front (time-segment-queue (car (schedule-segments sched))))
57 (test-eq (q-rear (time-segment-queue (car (schedule-segments sched))))
59 (test-eq ((q-front (time-segment-queue (car (schedule-segments sched)))))
61 (assert-times-expected (schedule-segments sched)
64 ;; Add another segment at (10 . 0)
65 (schedule-add! '(10 . 0) b-proc sched)
66 (test-assert (not (schedule-empty? sched)))
67 (test-equal (length (schedule-segments sched)) 1)
68 (test-equal (time-segment-time (car (schedule-segments sched)))
70 (test-equal (q-length (time-segment-queue (car (schedule-segments sched))))
72 (test-eq (q-front (time-segment-queue (car (schedule-segments sched))))
74 (test-eq (q-rear (time-segment-queue (car (schedule-segments sched))))
76 (assert-times-expected (schedule-segments sched)
79 ;; Add a segment to (11 . 0), (8 . 1) and (10 . 10)
80 (schedule-add! 11 c-proc sched)
81 (schedule-add! '(8 . 1) d-proc sched)
82 (schedule-add! '(10 . 10) e-proc sched)
83 (test-assert (not (schedule-empty? sched)))
84 (test-equal (length (schedule-segments sched)) 4)
85 (assert-times-expected (schedule-segments sched)
86 '((8 . 1) (10 . 0) (10 . 10) (11 . 0)))
89 (define (test-split-at schedule time expected-before expected-after)
90 (receive (segments-before segments-after)
91 (schedule-segments-split schedule time)
92 (assert-times-expected segments-before expected-before)
93 (assert-times-expected segments-after expected-after)))
95 (test-split-at sched 0
97 '((8 . 1) (10 . 0) (10 . 10) (11 . 0)))
98 (test-split-at sched '(8 . 0)
100 '((8 . 1) (10 . 0) (10 . 10) (11 . 0)))
101 (test-split-at sched '(8 . 1)
103 '((10 . 0) (10 . 10) (11 . 0)))
104 (test-split-at sched 9
106 '((10 . 0) (10 . 10) (11 . 0)))
107 (test-split-at sched 10
109 '((10 . 10) (11 . 0)))
110 (test-split-at sched 9000
111 '((8 . 1) (10 . 0) (10 . 10) (11 . 0))
113 (test-split-at sched '(9000 . 1) ; over nine thousaaaaaaand
114 '((8 . 1) (10 . 0) (10 . 10) (11 . 0))
117 ;; Break off half of those and do some tests on them
118 (define some-extracted
119 (schedule-extract-until! sched 10))
120 (assert-times-expected some-extracted '((8 . 1) (10 . 0)))
121 (assert-times-expected (schedule-segments sched) '((10 . 10) (11 . 0)))