test/activation.sgl

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

2 (sigil wm scene) (sigil wm model) (sigil wm repl) (sigil process))

3(for-each

4 (lambda (name)

5 (unless (guard (exception (#t #t)) (start-host! socket: name) #f)

6 (error "unsafe socket name was accepted" name)))

7 (list "bad/name" "." ".." "bad name" (make-string 64 #\x)))

8(define host (start-host! protocols: 258 socket: "activation-probe"))

9(define windows '())

10(define activations '())

11(define maximizes 0)

12(define configurations 0)

13(define errors '())

14(define (redraw!)

15 (submit-plan! host

16 (make-scene-plan

17 (map (lambda (id index)

18 (placement window: id box: (rect x: (* index 380) y: 0 width: 300 height: 300)))

19 windows (iota (length windows)))

20 (and (pair? windows) (car (reverse windows))) 200)))

21(on-event! host

22 (lambda (event)

23 (guard (exception

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

25 (let ((id (event-ref event id:)))

26 (case (event-type event)

27 ((ready)

28 (when (event-ref event session-available?:) (error "fixture requires no physical session"))

29 (unless (equal? (host-socket host) "activation-probe") (error "explicit socket was not selected"))

30 (configure-session-switches! host (list (cons #x1008fe01 1) (cons #x1008fe02 2)))

31 (configure-keyboard! host 1 "us" 25 600)

32 (set-seat-capabilities! host 3)

33 (set-pointer-route! host #t))

34 ((configuration-result)

35 (unless (event-ref event success?:) (error "explicit configuration failed"))

36 (set! configurations (+ configurations 1)))

37 ((output-added)

38 (configure-output! host id

39 (dict enabled: #t x: 0 y: 0 scale: 1 transform: 0 mode: -1

40 width: 960 height: 640 refresh: 60000)))

41 ((output-configured)

42 (display "WAYLAND_SOCKET=") (display (host-socket host)) (newline) (flush-output-port))

43 ((window-initial) (configure-window! host id 300 300))

44 ((window-mapped) (set! windows (append windows (list id))) (redraw!))

45 ((window-unmapped window-destroyed)

46 (when (memv id windows)

47 (set! windows (filter (lambda (window) (not (= window id))) windows))

48 (redraw!)))

49 ((activation-request) (set! activations (append activations (list event))))

50 ((window-request)

51 (when (= (event-ref event request:) 3)

52 (set! maximizes (+ maximizes 1))

53 (acknowledge-configure! host id)))

54 ((virtual-device-request) (reply-request! host id #t))

          ((command-rejected session-switch-result) (error "unexpected command or physical session action" (event-raw event))))))))

56(with-async

57 (let ((repl (start-repl! host (getenv "SIGIL_WM_REPL") (interaction-environment))))

58 (run-host! host)

59 (stop-repl! repl)))

60(unless (and (null? errors) (every (lambda (index) (= (host-statistic host index) 0)) '(1 2 3 4)))

61 (error "activation host retained resources or rejected commands" errors))

62(display "ACTIVATION_HOST=PASS\n")