192 lines
14 KiB
Common Lisp
192 lines
14 KiB
Common Lisp
;;;; Isolated X + fake MPD protocol peer. Never changes the user's audio/player.
|
|
(require :asdf)
|
|
(asdf:load-asd (truename (merge-pathnames "../lime.asd" *load-truename*)))
|
|
(asdf:load-system "lime/x11")
|
|
|
|
(let ((server (uiop:launch-program '("Xvfb" "-displayfd" "1" "-screen" "0" "1000x622x24" "-nolisten" "tcp")
|
|
:output :stream :error-output :interactive))
|
|
(backend nil) (checks 0) (listener nil) (peer nil) (peer-thread nil)
|
|
(peer-error nil) (gate (bt:make-lock)) (signal (bt:make-condition-variable))
|
|
(phase 0) (allow-change nil) (requests 0))
|
|
(unwind-protect
|
|
(let* ((number (parse-integer (read-line (uiop:process-info-output server))))
|
|
(display-name (format nil ":~D" number)))
|
|
(labels ((check (truth label) (assert truth () "Status: ~A" label) (incf checks))
|
|
(await (predicate &optional (seconds 3))
|
|
(let ((deadline (+ (get-internal-real-time) (* seconds internal-time-units-per-second))))
|
|
(loop until (funcall predicate)
|
|
do (when (> (get-internal-real-time) deadline) (error "Status test timed out: ~A" peer-error))
|
|
(sleep 0.005))))
|
|
(cached (id)
|
|
(getf (find id (lime.x11:backend-status-provider-report backend)
|
|
:key (lambda (entry) (getf entry :id))) :text))
|
|
(snapshot (id)
|
|
(getf (find id (lime.x11:backend-status-provider-report backend)
|
|
:key (lambda (entry) (getf entry :id))) :value))
|
|
(pump ()
|
|
(xlib:event-case ((lime.x11::x11-backend-display backend) :timeout 1 :discard-p t)
|
|
(:client-message (window type)
|
|
(lime.x11::%handle-status-notification backend window type) t)
|
|
(otherwise () t))))
|
|
(setf backend (lime.x11:start-lime :display-name display-name :head-discovery :none))
|
|
(let ((revision (lime.core:world-revision (lime.x11:x11-backend-world backend))))
|
|
;; Fake MPD retains a change occurring between snapshot and idle.
|
|
(setf listener (usocket:socket-listen "127.0.0.1" 0 :reuse-address t :element-type '(unsigned-byte 8)))
|
|
(setf peer-thread
|
|
(bt:make-thread
|
|
(lambda ()
|
|
(handler-case
|
|
(progn
|
|
(setf peer (usocket:socket-accept listener :element-type '(unsigned-byte 8)))
|
|
(let ((stream (usocket:socket-stream peer)))
|
|
(lime.x11::%mpd-send stream "OK MPD 0.24.0")
|
|
(loop for command = (lime.x11::%mpd-line stream)
|
|
do (incf requests)
|
|
(cond
|
|
((string= command "status")
|
|
(lime.x11::%mpd-send stream (if (zerop phase) "state: play" "state: pause"))
|
|
(lime.x11::%mpd-send stream "OK"))
|
|
((string= command "currentsong")
|
|
(lime.x11::%mpd-send stream "Title: 日本語 music")
|
|
(lime.x11::%mpd-send stream "OK"))
|
|
((string= command "idle player playlist")
|
|
(bt:with-lock-held (gate)
|
|
(loop until allow-change do (bt:condition-wait signal gate))
|
|
(setf allow-change nil))
|
|
(incf phase)
|
|
(lime.x11::%mpd-send stream "changed: player")
|
|
(lime.x11::%mpd-send stream "OK"))
|
|
(t (error "Unexpected MPD request: ~A" command))))))
|
|
(error (condition) (setf peer-error condition)))) :name "Fake MPD"))
|
|
(let* ((music (lime.x11:make-music-status-provider :mpd-port (usocket:get-local-port listener)))
|
|
(clock (lime.x11:make-clock-status-provider))
|
|
(config (lime.x11:make-lime-configuration :status-providers (list music clock)
|
|
:status-providers-supplied-p t)))
|
|
(lime.x11:apply-lime-configuration backend config)
|
|
(await (lambda () (and (cached :music) (cached :clock))))
|
|
(check (string= " 日本語 music" (cached :music)) "UTF-8 native MPD initial snapshot")
|
|
(check (equal '(:state :playing :title "日本語 music" :source :mpd) (snapshot :music)) "MPD publishes data, not icons")
|
|
(check (search "" (cached :clock)) "initial clock")
|
|
(check (= 2 (length (lime.x11::status-runtime-workers (lime.x11::x11-backend-status-runtime backend)))) "one worker per provider, not per Head")
|
|
(await (lambda () (>= requests 3)))
|
|
(let ((count requests))
|
|
(sleep 0.08)
|
|
(check (= count requests) "idle causes zero repeat MPD queries"))
|
|
;; Drain initial exposures and the initial coalesced publication.
|
|
(loop while (xlib:event-listen (lime.x11::x11-backend-display backend)) do (pump))
|
|
(let ((runtime (lime.x11::x11-backend-status-runtime backend)))
|
|
(check (not (lime.x11::status-runtime-dirty-p runtime)) "initial notification consumed")
|
|
(bt:with-lock-held (gate) (setf allow-change t) (bt:condition-notify signal))
|
|
(let ((start (get-internal-real-time)))
|
|
;; This waits for an actual X event, not a polling refresh.
|
|
(pump)
|
|
(check (< (/ (- (get-internal-real-time) start) internal-time-units-per-second) 0.75)
|
|
"publication wakes an idle X wait immediately"))
|
|
(check (string= " 日本語 music" (cached :music)) "pause event, no user input needed")
|
|
;; Presentation changes consume the cache on the X thread;
|
|
;; there is no new query, source restart, or source mutation.
|
|
(let* ((formatter (lime.x11:status-provider-formatter music))
|
|
(workers (copy-list (lime.x11::status-runtime-workers runtime)))
|
|
(before (snapshot :music))
|
|
(count requests))
|
|
(unwind-protect
|
|
(progn
|
|
(setf (lime.x11:status-provider-formatter music)
|
|
(lambda (data)
|
|
(lime.x11:make-head-bar-segment
|
|
:text (format nil "Track: ~A" (getf data :title)) :foreground "#55aa66")))
|
|
(lime.x11:apply-lime-configuration backend config)
|
|
(check (string= "Track: 日本語 music" (cached :music)) "configured label replaces default icons")
|
|
(check (equal before (snapshot :music)) "formatting leaves source data intact")
|
|
(check (equal workers (lime.x11::status-runtime-workers runtime)) "style reload keeps existing workers")
|
|
(check (= count requests) "style change does not query MPD")
|
|
(let* ((bar (gethash (first (lime.x11:backend-head-ids backend))
|
|
(lime.x11::x11-backend-head-bars backend)))
|
|
(pixels (lime.x11::ui-canvas-pixels (lime.x11::x11-head-bar-canvas bar))))
|
|
(check (loop for i below (array-total-size pixels)
|
|
thereis (= #x55aa66 (logand #xffffff (row-major-aref pixels i))))
|
|
"custom widget color actually painted"))
|
|
(setf (lime.x11:status-provider-formatter music)
|
|
(lambda (data) (declare (ignore data)) (error "broken fixture formatter")))
|
|
(lime.x11::render-head-bars backend)
|
|
(check (typep (lime.x11:backend-last-command-error backend) 'error) "formatter error isolated")
|
|
(check (cached :clock) "other widget survives formatter failure")
|
|
(check (equal before (snapshot :music)) "formatter failure preserves data")
|
|
(check (every (lambda (worker) (bt:thread-alive-p (lime.x11::status-worker-thread worker))) workers)
|
|
"formatter failure does not kill workers"))
|
|
(setf (lime.x11:status-provider-formatter music) formatter)
|
|
(lime.x11::render-head-bars backend)))
|
|
(let ((worker (find music (lime.x11::status-runtime-workers runtime)
|
|
:key #'lime.x11::status-worker-provider)))
|
|
(lime.x11:status-publish worker (snapshot :music))
|
|
(check (not (lime.x11::status-runtime-dirty-p runtime)) "identical data does not enqueue a redraw")
|
|
(lime.x11:status-publish worker '(:state :paused :title "burst one" :source :mpd))
|
|
(lime.x11:status-publish worker '(:state :paused :title "burst two" :source :mpd))
|
|
(pump)
|
|
(check (string= " burst two" (cached :music)) "coalesced notification paints latest value"))
|
|
(check (= revision (lime.core:world-revision (lime.x11:x11-backend-world backend))) "status never changes model state")
|
|
(let ((workers (copy-list (lime.x11::status-runtime-workers runtime))))
|
|
(lime.x11:apply-lime-configuration backend config)
|
|
(check (equal workers (lime.x11::status-runtime-workers runtime)) "same provider objects are not duplicated on reload"))
|
|
;; Failed reload must restore old providers with live workers.
|
|
(handler-case
|
|
(lime.x11:apply-lime-configuration
|
|
backend (lime.x11:make-lime-configuration
|
|
:status-providers (list (lime.x11:make-clock-status-provider :id :replacement))
|
|
:status-providers-supplied-p t
|
|
:startup-hooks (list (lambda (ignored) (declare (ignore ignored)) (error "test rollback"))))
|
|
:run-startup-hooks-p t)
|
|
(error ()))
|
|
(check (eq config (lime.x11:x11-backend-configuration backend)) "configuration rolled back")
|
|
(check (equal (sort (mapcar (lambda (entry) (getf entry :id)) (lime.x11:backend-status-provider-report backend))
|
|
#'string< :key #'symbol-name)
|
|
'(:clock :music)) "old provider set restored")
|
|
;; Stop while the clock sleeps and MPD is blocked in idle.
|
|
(let ((workers (copy-list (lime.x11::status-runtime-workers runtime)))
|
|
(start (get-internal-real-time)))
|
|
(lime.x11:backend-set-head-bar-status-providers backend nil)
|
|
(check (< (/ (- (get-internal-real-time) start) internal-time-units-per-second) 4) "bounded cancellation")
|
|
(check (every (lambda (worker) (not (bt:thread-alive-p (lime.x11::status-worker-thread worker)))) workers) "all removed workers joined")
|
|
(check (null (lime.x11::x11-backend-status-runtime backend)) "last removal closes notifier"))))
|
|
;; A failed source is isolated and retries while other widgets run.
|
|
(let* ((attempts 0)
|
|
(failed (lime.x11:make-status-provider
|
|
:id :test-retry
|
|
:run (lambda (worker)
|
|
(incf attempts)
|
|
(if (= attempts 1) (error "fixture unavailable")
|
|
(progn (lime.x11:status-publish worker "reconnected")
|
|
(lime.x11:status-wait worker 60))))))
|
|
(clock (lime.x11:make-clock-status-provider)))
|
|
(lime.x11:backend-set-head-bar-status-providers backend (list failed clock))
|
|
(await (lambda () (and (cached :clock) (cached :test-retry))))
|
|
(check (= 2 attempts) "source failure retries with backoff")
|
|
(check (string= "reconnected" (cached :test-retry)) "other providers survive failure"))
|
|
;; A blocked subprocess is killed/reaped, not left after reload.
|
|
(let ((provider (lime.x11:make-status-provider
|
|
:id :blocked-helper
|
|
:run (lambda (worker)
|
|
(lime.x11::%call-with-status-process
|
|
worker '("sleep" "60")
|
|
(lambda (stream process) (declare (ignore process))
|
|
(lime.x11::%status-read-line stream)))))))
|
|
(lime.x11:backend-set-head-bar-status-providers backend (list provider))
|
|
(let* ((runtime (lime.x11::x11-backend-status-runtime backend))
|
|
(worker (first (lime.x11::status-runtime-workers runtime))))
|
|
(await (lambda () (bt:with-lock-held ((lime.x11::status-worker-lock worker))
|
|
(lime.x11::status-worker-cancel-functions worker))))
|
|
(let ((start (get-internal-real-time)))
|
|
(lime.x11:backend-set-head-bar-status-providers backend nil)
|
|
(check (< (/ (- (get-internal-real-time) start) internal-time-units-per-second) 1)
|
|
"blocked helper cancellation is immediate")
|
|
(check (not (bt:thread-alive-p (lime.x11::status-worker-thread worker))) "helper reader joined"))))
|
|
(format t "~&Status live-X smoke: ~D checks passed.~%" checks))))
|
|
(when backend (lime.x11:stop-backend backend))
|
|
(bt:with-lock-held (gate) (setf allow-change t) (bt:condition-notify signal))
|
|
(when peer (ignore-errors (usocket:socket-shutdown peer :io)))
|
|
(when listener (ignore-errors (usocket:socket-close listener)))
|
|
(when peer-thread (bt:join-thread peer-thread))
|
|
(when peer (ignore-errors (usocket:socket-close peer)))
|
|
(uiop:terminate-process server)
|
|
(uiop:wait-process server)))
|