test/deadline-live.sgl

1(import (sigil async) (sigil io) (sigil time)

2 (sigil wm host) (sigil wm input))

3(define (check x message) (unless x (error message)))

4(define (now-ms) (* 1000 (/ (current-jiffy) (jiffies-per-second))))

5(define (await predicate)

6 (let loop ((n 0))

7 (unless (predicate) (check (< n 500) "native deadline-live timeout")

8 (sleep .005) (loop (+ n 1)))))

9(define host (start-host!))

10(define output #f)

11(define presses 0)

12(define motions '())

13(define (configure enabled?)

14 (configure-output! host output

15 (dict enabled: enabled? x: 0 y: 0 scale: 1 transform: 0 mode: -1 width: 800 height: 600 refresh: 60000)))

16(on-event! host (lambda (event)

17 (when (eq? (event-type event) 'output-added)

18 (set! output (event-ref event id:)) (configure #t))))

19(with-async

20 (go (run-host! host))

21 (await (lambda () (let ((records (dict-ref (host-output-inventory host) connectors:)))

22 (and (pair? records) (dict-ref (car records) enabled?:)))))

23 (set-key-hook! host (lambda (event)

24 (when (= (input-event-state event) 1)

25 (set! presses (+ presses 1))

26 (when (= presses 1) (sleep .07)))

27 (drop)))

28 (check (configure-keyboard! host 1 "us" 30 400) "keyboard repeat configuration failed")

29 ;; Repeated presses and releases still drain after a handler crosses the

30 ;; bound-key deadline; the timer must retire that budget only once.

31 (go (do ((i 0 (+ i 1))) ((= i 20))

32 (emulate-key! host 1 30 #t) (emulate-key! host 1 30 #f) (sleep .008)))

33 (await (lambda () (= presses 20)))

34 (check (> (host-statistic host 10) 0) "bound input deadline did not fire")

35 (set-motion-hook! host (lambda (event) (set! motions (append motions (list (now-ms)))) (forward event))

36 0 80 '(0 0 800 600))

37 (emulate-motion! host 1 10 10)

38 (await (lambda () (= (length motions) 1)))

39 (emulate-motion! host 1 20 20)

40 (await (lambda () (= (length motions) 2)))

41 (check (and (>= (- (cadr motions) (car motions)) 55)

42 (< (- (cadr motions) (car motions)) 300)) "coalesced motion deadline shifted")

43 (set-motion-hook! host #f 0 0 '(0 0 0 0))

44 (sleep .05)

45 (let ((before (host-statistic host 12)))

46 (begin-scene-update! host 25)

47 (sleep .07)

48 (check (> (host-statistic host 12) before) "scene bracket deadline did not fire"))

49 (configure #f)

50 (await (lambda () (not (dict-ref (car (dict-ref (host-output-inventory host) connectors:)) enabled?:))))

51 (sleep .1)

52 (let ((before (host-statistic host 12)))

53 (sleep .3)

54 (check (= before (host-statistic host 12)) "blanked native host woke on maintenance timer"))

55 (configure #t)

56 (await (lambda () (dict-ref (car (dict-ref (host-output-inventory host) connectors:)) enabled?:)))

57 (stop-host! host))

58(display "DEADLINE_LIVE=PASS repeat-stream bound-timeout motion scene blanked-zero wake\n")