test-timer.rkt
#lang racket/base

(require "main.rkt")

(define (drive-multiple name tm)
  (printf "MULTIPLE START ~a~n" name)
  (let loop ()
    (when (not (timer-manager-idle? tm))
      (printf "Syncing~n")
      (sync (fire-timers-evt tm))
      (loop)))
  (printf "MULTIPLE STOP  ~a~n" name))

(define (drive-single name tm)
  (printf "SINGLE START ~a~n" name)
  (let loop ()
    (when (not (timer-manager-idle? tm))
      (printf "Syncing~n")
      (sync (fire-single-timer-evt tm
				   (lambda (v)
				     (printf "(yielded ~a)~n" v)
				     (loop))
				   (lambda ()
				     (printf "(skipped)~n")
				     (loop))))))
  (printf "SINGLE STOP  ~a~n" name))

(define (test-multiple-firing driver)
  (define tm (make-timer-manager))
  (add-relative-timer! tm 200 (lambda () (printf "t3~n") 3))
  (add-relative-timer! tm 200 (lambda () (printf "t2~n") 2))
  (add-relative-timer! tm 100 (lambda () (printf "t1~n") (sleep 0.2) 1))
  (driver 'test-multiple-firing tm))

(define (test-cancellation driver)
  (define tm (make-timer-manager))
  (add-relative-timer! tm 300 (lambda () (printf "t3~n") 3))
  (define t2 (add-relative-timer! tm 200 (lambda () (printf "t2~n") 2)))
  (add-relative-timer! tm 100 (lambda () (cancel-timer! t2) (printf "t1~n") 1))
  (driver 'test-cancellation tm))

(module+ main
  (test-multiple-firing drive-multiple)
  (test-cancellation drive-multiple)
  (test-multiple-firing drive-single)
  (test-cancellation drive-single))