5 (define-module (tests test-core)
6 #:use-module (srfi srfi-64)
8 #:use-module (loopy agenda))
16 (test-assert (time-= '(1 . 1) '(1 . 1)))
17 (test-assert (not (time-= '(1 . 1) '(1 . 0))))
18 (test-assert (not (time-= '(0 . 1) '(1 . 1))))
20 (test-assert (time-< '(1 . 1) '(1 . 2)))
21 (test-assert (time-< '(7 . 2) '(8 . 2)))
22 (test-assert (not (time-< '(7 . 2) '(7 . 2))))
23 (test-assert (not (time-< '(7 . 8) '(7 . 2))))
24 (test-assert (not (time-< '(8 . 2) '(7 . 2))))
32 (define a-proc (const 'a))
33 (define b-proc (const 'b))
34 (define c-proc (const 'c))
36 (define sched (make-schedule))
37 (test-assert (schedule-empty? sched))
39 ;; Add a segment at (10 . 0)
40 (schedule-add! 10 a-proc sched)
41 (test-assert (not (schedule-empty? sched)))
42 (test-equal (length (schedule-segments sched)) 1)
43 (test-equal (time-segment-time (car (schedule-segments sched)))
45 (test-equal (q-length (time-segment-queue (car (schedule-segments sched))))
47 (test-eq (q-front (time-segment-queue (car (schedule-segments sched))))
49 (test-eq (q-rear (time-segment-queue (car (schedule-segments sched))))
52 ;; Add another segment at (10 . 0)
53 (schedule-add! '(10 . 0) b-proc sched)
54 (test-assert (not (schedule-empty? sched)))
55 (test-equal (length (schedule-segments sched)) 1)
56 (test-equal (time-segment-time (car (schedule-segments sched)))
58 (test-equal (q-length (time-segment-queue (car (schedule-segments sched))))
60 (test-eq (q-front (time-segment-queue (car (schedule-segments sched))))
62 (test-eq (q-rear (time-segment-queue (car (schedule-segments sched))))
65 ;; Add a segment to (11 . 0), (8 . 1) and (10 . 10)
66 (schedule-add! 11 a-proc sched)
67 (schedule-add! '(8 . 1) c-proc sched)
68 (schedule-add! '(10 . 10) c-proc sched)
69 (test-assert (not (schedule-empty? sched)))
70 (test-equal (length (schedule-segments sched)) 4)
71 (test-equal (time-segment-time (car (schedule-segments sched)))
73 (test-equal (time-segment-time (cadr (schedule-segments sched)))
75 (test-equal (time-segment-time (caddr (schedule-segments sched)))
77 (test-equal (time-segment-time (cadddr (schedule-segments sched)))