audio stuff

dlna-player.rkt

@@ -406,12 +406,14 @@
          #t)))))
 
 (define (poll-player player)
-  (let loop ()
-    (when (dlna-player-running? player)
-      (sleep (dlna-player-poll-seconds player))
-      (when (dlna-player-running? player)
-        (refresh-player! player)
-        (loop)))))
+  (with-handlers ([exn:break? void])
+    (parameterize-break #t
+      (let loop ()
+        (when (dlna-player-running? player)
+          (sleep (dlna-player-poll-seconds player))
+          (when (dlna-player-running? player)
+            (refresh-player! player)
+            (loop)))))))
 
 (define (renderer-local-address renderer)
   (let ([socket (udp-open-socket)])
@@ -882,7 +884,9 @@
     (set-dlna-player-running?! player #f)
     (let ([poll-thread (dlna-player-poll-thread player)])
       (when poll-thread
-        (kill-thread poll-thread)
+        ;; A break unwinds call-with-semaphore; kill-thread leaves its lock held.
+        (break-thread poll-thread)
+        (thread-wait poll-thread)
         (set-dlna-player-poll-thread! player #f)))
     (with-handlers ([exn:fail? (lambda (_) (void))])
       (call-with-semaphore
@@ -898,3 +902,35 @@
     (when (dlna-player-owns-server? player)
       (media-file-server-stop! (dlna-player-server player))))
   (void))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Tests for module dlna-player.rkt
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(module+ test
+  (require rackunit)
+
+  (test-case "closing during a renderer poll releases the transport lock"
+    (let* ((lock (make-semaphore 1))
+           (ready (make-semaphore))
+           (custodian (make-custodian))
+           (poller
+            (parameterize ((current-custodian custodian))
+              (thread
+               (λ ()
+                 (with-handlers ((exn:break? void))
+                   (call-with-semaphore
+                    lock
+                    (λ () (semaphore-post ready) (sync never-evt))))))))
+           (player
+            (make-dlna-player-state #f #f #f "" 1 5 lock (make-semaphore 1)
+                                   #f #f #f 0 0 (make-hash) 0 #t poller)))
+      (dynamic-wind
+        void
+        (λ ()
+          (semaphore-wait ready)
+          (let ((closer (parameterize ((current-custodian custodian))
+                          (thread (λ () (dlna-player-close! player))))))
+            (check-not-false (sync/timeout 2 closer))
+            (check-true (semaphore-try-wait? lock))))
+        (λ () (custodian-shutdown-all custodian))))))