test/trace-inventory.sgl

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

2 (sigil wm model) (sigil wm trace))

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

4(define (await predicate)

5 (let loop ((n 0))

6 (unless (predicate)

7 (check (< n 500) "headless trace/inventory deadline")

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

9(configure-trace! #t)

10(define host (start-host!))

11(define records '())

12(define output #f)

13(on-event! host

14 (lambda (event)

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

16 (set! output (event-ref event id:))

17 (check (configure-output! host output

18 (dict enabled: #t x: 0 y: 0 scale: 1 transform: 0 mode: -1 width: 800 height: 600 refresh: 60000))

19 "headless configuration not queued"))))

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

21 (when (eq? (event-type event) 'trace-record)

22 (check (exact? (event-ref event monotonic-ns:)) "timestamp lost integer precision at FFI boundary")

23 (set! records (cons event records)))))

24(define (presented? id)

25 (any (lambda (event) (and (= (event-ref event id:) id) (= (event-ref event stage:) 9))) records))

26(with-async

27 (go (run-host! host))

28 (await (lambda () (let ((items (dict-ref (host-output-inventory host) connectors:)))

29 (and (pair? items) (dict-ref (car items) enabled?:)))))

30 (let ((pixels (c-alloc 4)))

31 (dynamic-wind (lambda () (pointer-set! pixels ffi/uint32 0 #xffff0000))

32 (lambda ()

33 (parameterize ((current-trace-causes '(101 202)))

34 (check (present-pixels! host 900 pixels 1 1 4 (rect x: 10 y: 10 width: 20 height: 20) 1 stretch?: #t)

35 "coalesced pixel upload failed"))

36 (parameterize ((current-trace-correlation 303))

37 (check (submit-plan! host (make-scene-plan '() 0 200)) "plan upload failed"))

38 (await (lambda () (and (presented? 101) (presented? 202) (presented? 303))))

39 (for-each

40 (lambda (id)

41 (let ((commits (filter (lambda (event)

42 (and (= (event-ref event id:) id) (= (event-ref event stage:) 8))) records))

43 (presents (filter (lambda (event)

44 (and (= (event-ref event id:) id) (= (event-ref event stage:) 9))) records)))

45 (check (any (lambda (commit)

46 (any (lambda (present)

                                   (= (event-ref commit commit-sequence:) (event-ref present commit-sequence:))) presents)) commits)

48 "present lost its causal commit"))) '(101 202 303))

49 (check (= (trace-dropped) 0) "unexpected trace drops")

50 (let ((before (host-output-inventory host)))

51 (check (configure-output! host output

52 (dict enabled: #f x: 0 y: 0 scale: 1 transform: 0 mode: -1 width: 800 height: 600 refresh: 60000))

53 "disable not queued")

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

55 (check (dict-ref (car (dict-ref before connectors:)) enabled?:) "inventory copy mutated")))

56 (lambda () (c-free pixels))))

57 (stop-host! host))

58(display "TRACE_INVENTORY=PASS headless copied causal-lists commit present disable\n")