tests.scm

   1 #!/usr/bin/guile \
   2 -s
   3 !#
   4
   5 (define-module (tests test-core)
   6   #:use-module (srfi srfi-64)
   7   #:use-module (ice-9 q)
   8   #:use-module (loopy agenda))
   9
  10 (test-begin "tests")
  11
  12 \f
  13 ;; Timer tests
  14 ;; ===========
  15
  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))))
  19
  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))))
  25
  26
  27 \f
  28 ;;; Schedule tests
  29 ;;; ==============
  30
  31 ;; helpers
  32 (define a-proc (const 'a))
  33 (define b-proc (const 'b))
  34 (define c-proc (const 'c))
  35
  36 (define sched (make-schedule))
  37 (test-assert (schedule-empty? sched))
  38
  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)))
  44   '(10 . 0))
  45 (test-equal (q-length (time-segment-queue (car (schedule-segments sched))))
  46   1)
  47 (test-eq (q-front (time-segment-queue (car (schedule-segments sched))))
  48   a-proc)
  49 (test-eq (q-rear (time-segment-queue (car (schedule-segments sched))))
  50   a-proc)
  51
  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)))
  57   '(10 . 0))
  58 (test-equal (q-length (time-segment-queue (car (schedule-segments sched))))
  59   2)
  60 (test-eq (q-front (time-segment-queue (car (schedule-segments sched))))
  61   a-proc)
  62 (test-eq (q-rear (time-segment-queue (car (schedule-segments sched))))
  63   b-proc)
  64
  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)))
  72   '(8 . 1))
  73 (test-equal (time-segment-time (cadr (schedule-segments sched)))
  74   '(10 . 0))
  75 (test-equal (time-segment-time (caddr (schedule-segments sched)))
  76   '(10 . 10))
  77 (test-equal (time-segment-time (cadddr (schedule-segments sched)))
  78   '(11 . 0))
  79
  80
  81 ;; End tests
  82
  83 (test-end "tests")
  84 ;; (test-exit)
  85