Ignore errors from close-channel or delete-subprocess.
authorMatt Birkholz <puck@birchwood-abbey.net>
Sat, 11 Jul 2015 20:34:47 +0000 (13:34 -0700)
committerMatt Birkholz <puck@birchwood-abbey.net>
Sat, 11 Jul 2015 20:34:47 +0000 (13:34 -0700)
src/runtime/thread.scm

index 496a335607fe2ee363486f8fc191fb2b3c282a51..4e549489b02c04d1ae25c07f55967fd7359776a6 100644 (file)
@@ -789,12 +789,18 @@ USA.
      (%maybe-toggle-thread-timer))))
 
 (define (deregister-io-descriptor descriptor close-descriptor!)
-  (with-thread-lock
-   (lambda ()
-     (%deregister-io-descriptor* descriptor)
-     (close-descriptor!))))
-
-(define (%deregister-io-descriptor* descriptor)
+  (let ((error?
+        (with-thread-lock
+         (lambda ()
+           (%deregister-io-descriptor descriptor)
+           (ignore-errors
+            (lambda ()
+              (close-descriptor!)
+              #f))))))
+    (if error?
+       (signal-condition error?))))
+
+(define (%deregister-io-descriptor descriptor)
   (let dloop ((dentry io-registrations))
     (cond ((not dentry)
           unspecific)
@@ -1158,15 +1164,21 @@ USA.
           (delq! registration subprocess-registrations)))))
 
 (define (deregister-subprocess subprocess delete-subprocess!)
-  (with-thread-lock
-   (lambda ()
-     (set! subprocess-registrations
-          (filter!
-           (lambda (registration)
-             (not (eq? subprocess
-                       (subprocess-registration/subprocess registration))))
-                   subprocess-registrations))
-     (delete-subprocess!))))
+  (let ((error?
+        (with-thread-lock
+         (lambda ()
+           (set! subprocess-registrations
+                 (filter!
+                  (lambda (registration)
+                    (not (eq? subprocess (subprocess-registration/subprocess
+                                          registration))))
+                  subprocess-registrations))
+           (ignore-errors
+            (lambda ()
+              (delete-subprocess!)
+              #f))))))
+    (if error?
+       (signal-condition error?))))
 
 (define (%deregister-subprocess-events thread)
   (%assert-locked '%deregister-subprocess-events)