scripts/test-keyboard-group

1#!/usr/bin/env bash

2set -euo pipefail

3cd "$(dirname "$0")/.."

4make -j2 all build/protocol-client build/input-driver

5mkdir -p build/receipts

6runtime_dir=$(mktemp -d /tmp/sigil-wm-keyboard-group.XXXXXX)

7export XDG_RUNTIME_DIR="$runtime_dir" SIGIL_WM_REPL="$runtime_dir/repl"

8export WLR_BACKENDS=headless WLR_RENDERER=pixman WLR_HEADLESS_OUTPUTS=1

9unset WAYLAND_DISPLAY DISPLAY

10server_pid= client_pid= input_pid=

11cleanup() {

12 for child in "$input_pid" "$client_pid" "$server_pid"; do

13 [[ -z $child ]] || kill "$child" 2>/dev/null || true

14 [[ -z $child ]] || wait "$child" 2>/dev/null || true

15 done

16 rm -rf "$runtime_dir"

17}

18trap cleanup EXIT

19value() { bash scripts/msg "$SIGIL_WM_REPL" "$1"; }

20wait_value() {

21 for ((attempt=0; attempt<100; attempt++)); do

22 if value "$1" | grep -q '(value #t)'; then return; fi

23 sleep 0.05

24 done

25 cat build/receipts/keyboard-group.log >&2

26 printf 'WAIT_FAILED=%s\n' "$1" >&2

27 return 1

28}

29wait_log() {

30 for ((attempt=0; attempt<600; attempt++)); do

31 if grep -q "$2" "$1" 2>/dev/null; then return; fi

32 sleep 0.1

33 done

34 tail -20 "$1" >&2

35 return 1

36}

37timeout 180 bash scripts/run-sigil -L src eval -f test/keyboard-group.sgl > build/receipts/keyboard-group.log 2>&1 &

38server_pid=$!

39wait_log build/receipts/keyboard-group.log '^WAYLAND_SOCKET='

40export WAYLAND_DISPLAY

41WAYLAND_DISPLAY=$(sed -n 's/^WAYLAND_SOCKET=//p' build/receipts/keyboard-group.log | head -1)

42mkfifo "$runtime_dir/client-control" "$runtime_dir/input-control"

43exec {client_control}<> "$runtime_dir/client-control"

44exec {input_control}<> "$runtime_dir/input-control"

SIGIL_WM_CLIENT_CONTROL=1 SIGIL_WM_CLIENT_XDG_VERSION=6 timeout 150 build/protocol-client green 36000 < "$runtime_dir/client-control" > build/receipts/keyboard-group-client.log 2>&1 &

46client_pid=$!

47wait_value '(and (= (length windows) 1) (equal? last-plan applied-plan))'

48value '(define live-window (car windows))'

49value '(define first-observation (query-window! host live-window))'

wait_value '(and (pair? observations) (pair? extents) (= (event-ref (car observations) id:) first-observation) (= (event-ref (car extents) id:) first-observation))'

51value '(define first-copy (car observations))'

wait_value '(and (event-ref first-copy accepted?:) (event-ref first-copy mapped?:) (event-ref first-copy visible?:) (event-ref first-copy focused?:) (event-ref first-copy xdg-state?:) (not (event-ref first-copy activated?:)) (= (event-ref first-copy width:) 360) (= (event-ref first-copy height:) 240) (= (event-ref (car extents) version:) 6))'

value '(define moved-plan (submit-plan! host (make-scene-plan (list (placement window: live-window box: (rect x: 25 y: 30 width: 300 height: 180) activated?: #t tiled: 15)) live-window 200)))'

54wait_value '(equal? applied-plan moved-plan)'

55value '(define moved-observation (query-window! host live-window))'

wait_value '(and (= (event-ref (car observations) id:) moved-observation) (= (event-ref (car observations) x:) 25) (= (event-ref (car observations) y:) 30) (= (event-ref (car observations) width:) 300) (= (event-ref (car observations) height:) 180) (event-ref (car observations) activated?:) (= (event-ref (car observations) tiled:) 15) (= (event-ref first-copy width:) 360))'

57before_configures=$(grep -c '^CLIENT_CONFIGURE=' build/receipts/keyboard-group-client.log)

value '(define unchanged-plan (submit-plan! host (make-scene-plan (list (placement window: live-window box: (rect x: 25 y: 30 width: 300 height: 180) activated?: #t tiled: 15)) live-window 200)))'

59wait_value '(equal? applied-plan unchanged-plan)'

60[[ $(grep -c '^CLIENT_CONFIGURE=' build/receipts/keyboard-group-client.log) == "$before_configures" ]]

61echo 'SCENE_NOOP=PASS unchanged plan sends no redundant client configure'

62timeout 150 build/input-driver < "$runtime_dir/input-control" > build/receipts/keyboard-group-input.log 2>&1 &

63input_pid=$!

64wait_log build/receipts/keyboard-group-input.log '^INPUT_DEVICE_READY'

wait_value '(and (find (lambda (record) (= (dict-ref record device-type:) 0)) (dict-ref (host-snapshot host) devices:)) #t)'

value '(define device (dict-ref (find (lambda (record) (= (dict-ref record device-type:) 0)) (dict-ref (host-snapshot host) devices:)) id:))'

67printf 'group 0\nkey 35\n' >&"$input_control"

68wait_value '(equal? keys (quote ((2023))))'

69wait_log build/receipts/keyboard-group-client.log '^CLIENT_KEYSYM=35,1,2023$'

70value '(begin (set! keys (quote ())) (set-keyboard-group! host device 1 fixed?: #f) (set-keyboard-group! host 1 0))'

71printf 'group 0\nkey 35\n' >&"$input_control"

72wait_value '(equal? keys (quote ((104))))'

73wait_log build/receipts/keyboard-group-client.log '^CLIENT_KEYSYM=35,1,104$'

value '(begin (set! keys (quote ())) (configure-keyboard! host device "us,gr" 25 600 group: 1 fixed-group?: #t) (set-keyboard-group! host 1 1))'

75sleep 0.1

76printf 'group 0\nkey 35\n' >&"$input_control"

77wait_value '(equal? keys (quote ((2023))))'

78value '(do ((index 0 (+ index 1))) ((= index 20)) (emulate-key! host 1 30 #t) (emulate-key! host 1 30 #f))'

79wait_value '(and (= binding-presses 20) (= (dict-ref (host-snapshot host) focus:) live-window))'

80if grep -q '^CLIENT_KEY=30,' build/receipts/keyboard-group-client.log; then exit 1; fi

81before_keys=$(grep -c '^CLIENT_KEY=35,1' build/receipts/keyboard-group-client.log)

82value '(begin (set! delay-forward? #t) (emulate-key! host 1 35 #t) (emulate-key! host 1 35 #f) (focus-window! host 0))'

83wait_value '(= (dict-ref (host-snapshot host) focus:) 0)'

84sleep 0.2

85[[ $(grep -c '^CLIENT_KEY=35,1' build/receipts/keyboard-group-client.log) == "$before_keys" ]]

86value '(begin (set! delay-forward? #f) (focus-window! host live-window))'

87wait_value '(= (dict-ref (host-snapshot host) focus:) live-window)'

88value '(begin (emulate-key! host 1 36 #t) (emulate-key! host 1 36 #f))'

89wait_log build/receipts/keyboard-group-client.log '^CLIENT_KEY=36,1$'

echo 'SEMANTIC_KEYS=PASS twenty queued binding presses across focus epochs stale forwarding refused fresh forwarding restored'

91for pair in 4:31 8:32 1:33 64:34; do

92 modifier=${pair%:*} keycode=${pair#*:}

93 printf 'mods %s\nkey %s\nmods 0\n' "$modifier" "$keycode" >&"$input_control"

94 wait_log build/receipts/keyboard-group-client.log "^CLIENT_KEY_MODIFIERS=$keycode,1,$modifier,1$"

95 wait_log build/receipts/keyboard-group-client.log "^CLIENT_KEY_MODIFIERS=$keycode,0,$modifier,1$"

96done

97echo 'FORWARDED_MODIFIERS=PASS real Control Alt Shift Super snapshots on key press and release'

98value '(begin (set! keys (quote ())) (define refused-keymap (configure-keyboard! host 1 "zz-no-such-layout" 25 600)))'

wait_value '(and (pair? configurations) (= (event-ref (car configurations) id:) refused-keymap) (not (event-ref (car configurations) success?:)))'

100value '(begin (emulate-key! host 1 35 #t) (emulate-key! host 1 35 #f))'

101wait_value '(equal? keys (quote ((2023))))'

102echo 'KEYBOARD_REFUSAL=PASS invalid keymap typed refusal previous group and symbols retained'

103

value '(define hidden-plan (submit-plan! host (make-scene-plan (list (placement window: live-window box: (rect x: 0 y: 0 width: 360 height: 240) shown?: #f suspended?: #t resize?: #f)) 0 200)))'

104wait_value '(equal? applied-plan hidden-plan)'

105printf 'z\n' >&"$client_control"

106wait_log build/receipts/keyboard-group-client.log '^CLIENT_SYNC=z$'

107value '(define hidden-state (query-window! host live-window))'

108

wait_value '(and (= (event-ref (car observations) id:) hidden-state) (event-ref (car observations) suspended?:) (not (event-ref (car observations) visible?:)) (= (event-ref (car observations) width:) 300) (= (event-ref (car observations) height:) 180))'

109echo 'WINDOW_SUSPENSION=PASS explicit version-six committed state independent visibility and focus'

110

111value '(define hidden-focus (focus-window! host live-window))'

112

wait_value '(and (pair? focus-results) (= (event-ref (car focus-results) id:) hidden-focus) (not (event-ref (car focus-results) accepted?:)) (= (dict-ref (host-snapshot host) focus:) 0))'

113printf 'q\n' >&"$client_control"

114wait "$client_pid"

115client_pid=

116wait_value '(null? windows)'

117value '(define retired-observation (query-window! host live-window))'

118

wait_value '(and (= (event-ref (car observations) id:) retired-observation) (not (event-ref (car observations) accepted?:)))'

119

echo 'WINDOW_OBSERVATION=PASS actual scene committed protocol state offsets version detached prior facts typed retirement refusal'

120value '(define retired-focus (focus-window! host live-window))'

121

wait_value '(and (= (event-ref (car focus-results) id:) retired-focus) (not (event-ref (car focus-results) accepted?:)))'

122kill "$input_pid"

123wait "$input_pid" 2>/dev/null || true

124input_pid=

125value '(stop-host! host)'

126wait "$server_pid"

127server_pid=

128grep -q '^KEYBOARD_GROUP_HOST=PASS' build/receipts/keyboard-group.log

129

echo 'KEYBOARD_GROUP=PASS fixed and following backend groups atomic reconfiguration real client keysyms typed hidden and retired focus refusal clean lifetime'