test/output-power-batch.sgl

1(import (sigil async) (sigil io) (sigil wm host))

2(define host (start-host! protocols: 128))

3(define outputs '())

4(define stage 'initial)

5(define token #f)

6(define errors '())

7(define before #f)

8(define (require condition message)

9 (unless condition (error message)))

10(define (record id)

11 (find (lambda (record) (= (dict-ref record id:) id)) (dict-ref (host-snapshot host) outputs:)))

12(define (settings preserve?)

13 (map (lambda (id index)

14 (dict id: id enabled: #t power?: (or (not preserve?) (> index 0))

15 x: (+ 100 (* index 960)) y: 50 scale: 1 transform: 0

16 mode: -1 width: 960 height: 640 refresh: 60000))

17 outputs (iota (length outputs))))

18(on-event! host

19 (lambda (event)

20 (guard (exception

21 (#t (set! errors (cons exception errors)) (write exception) (newline) (stop-host! host)))

22 (case (event-type event)

23 ((output-added) (set! outputs (append outputs (list (event-ref event id:)))))

24 ((ready)

25 (require (= (length outputs) 2) "power batch needs two outputs")

26 (set! token (configure-outputs! host (settings #f))))

27 ((configuration-result)

28 (when (= (event-ref event id:) token)

29 (require (event-ref event success?:) "output batch was refused")

30 (case stage

31 ((initial)

32 (set! stage 'off)

33 (set-output-power! host (car outputs) #f))

34 ((reflow)

35 (let ((off (record (car outputs))) (on (record (cadr outputs))))

36 (require (dict-ref off enabled?:) "reflow disabled the sleeping output")

37 (require (not (dict-ref off powered?:)) "reflow powered on the sleeping output")

38 (require (dict-ref on powered?:) "reflow powered off the other output")

39 (require (= (dict-ref off x:) 100) "sleeping output lost its position")

40 (require (= (dict-ref off y:) 50) "sleeping output lost its vertical position")

41 (require (= (dict-ref off width:) 960) "sleeping output lost logical width")

42 (require (= (dict-ref off refresh:) 60000) "refresh facts were lost")

43 (require (= (dict-ref off mode:) -1) "custom mode fact was lost"))

44 (require (dict-ref (car (dict-ref before outputs:)) powered?:)

45 "prior output snapshot was mutated")

46 (set! stage 'on)

47 (set-output-power! host (car outputs) #t)))))

48 ((output-power-changed)

49 (when (= (event-ref event id:) (car outputs))

50 (case stage

51 ((off)

52 (require (not (event-ref event on?:)) "output did not power off")

53 (set! stage 'reflow)

54 (set! token (configure-outputs! host (settings #t))))

55 ((on)

56 (require (event-ref event on?:) "output did not power on")

57 (require (dict-ref (record (car outputs)) enabled?:) "power on lost logical admission")

58 (set! stage 'complete)

59 (stop-host! host)))))

60 ((output-configured)

61 (when (and (eq? stage 'initial) (every (lambda (id) (dict-ref (record id) powered?:)) outputs))

62 (set! before (host-snapshot host))))

63 ((command-rejected) (error "power batch command rejected" (event-raw event)))))))

64(with-async (run-host! host))

65(unless (and (eq? stage 'complete) (null? errors)

66 (every (lambda (index) (= (host-statistic host index) 0)) '(1 2 3 4)))

67 (error "output power batch failed" stage errors))

68(display "OUTPUT_POWER_BATCH=PASS logical admission sleeping reflow wake immutable facts ownership\n")