deregister semaphore for a blocking file descriptor

The rktio conversion lost the deregistration of file descriptors in an
internal fd-to-semaphore table building on kqueue/epoll, causing the
wrong semaphore to be checked for a later recycling of the file
descriptor. This bug mainly affects Linux and ports created by
`subprocess`, since kqueue is not used for pipes on Mac OS and BSD
variants. The bug does not affect network sockets (which are the
primary intended clients of epoll/kqueue support), since the relevant
semaphore is deregistered when a socket is closed.

Thanks to James Bornholt for discovering the problem and providing the
repair.

Closes #1769

pkgs/racket-test-core/tests/racket/subprocess.rktl

@@ -478,25 +478,47 @@
 ;; Check setting of PWD and initializing `current-directory' from
 ;; PWD, when it involves a soft link:
 (when (member (system-type) '(unix macosx))
-  (let ([dir (make-temporary-file "sub~a" 'directory)])
-    (make-directory (build-path dir "a"))
-    (make-file-or-directory-link "a" (build-path dir "b"))
-    (current-directory (build-path dir "b"))
-    
-    (define o (open-output-bytes))
-    (parameterize ([current-output-port o])
-      (system* self "-e" "(current-directory)"))
-    (test (format "~s\n" (path->directory-path (build-path dir "b"))) get-output-string o)
+  (parameterize ([current-directory (current-directory)])
+    (let ([dir (make-temporary-file "sub~a" 'directory)])
+      (make-directory (build-path dir "a"))
+      (make-file-or-directory-link "a" (build-path dir "b"))
+      (current-directory (build-path dir "b"))
+      
+      (define o (open-output-bytes))
+      (parameterize ([current-output-port o])
+        (system* self "-e" "(current-directory)"))
+      (test (format "~s\n" (path->directory-path (build-path dir "b"))) get-output-string o)
 
-    (define o2 (open-output-bytes))
-    (parameterize ([current-output-port o2])
-      (system* self "-e" "(current-directory)" #:set-pwd? #f))
-    (test (format "~s\n" (path->directory-path (normalize-path (build-path dir "a")))) get-output-string o2)
-    
-    (delete-directory/files dir)))
+      (define o2 (open-output-bytes))
+      (parameterize ([current-output-port o2])
+        (system* self "-e" "(current-directory)" #:set-pwd? #f))
+      (test (format "~s\n" (path->directory-path (normalize-path (build-path dir "a")))) get-output-string o2)
+      
+      (delete-directory/files dir))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Make sure that the reading from a file descriptor from `subprocess`
+;; doesn't fail to unregister it in the fd-semaphore table, which
+;; could cause this test to block waiting on a semaphore that
+;; won't get posted due to recycling a now-closed fd
+
+(for ([i 25])
+  (let ([p (process* cat)])
+    (define t
+      (thread (lambda ()
+                (read-bytes 100 (car p)))))
+    (sync (system-idle-evt))
+    (when (even? i) (kill-thread t))
+    (close-output-port (cadr p))
+    (thread-wait t)
+    ((list-ref p 4) 'wait)
+    (test 'done-ok (list-ref p 4) 'status)
+    (close-input-port (car p))
+    (close-input-port (cadddr p))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (for ([f (list tmpfile tmpfile2)] #:when (file-exists? f)) (delete-file f))
 
+
 (report-errs)

racket/src/racket/src/port.c

@@ -4819,9 +4819,10 @@ fd_close_input(Scheme_Input_Port *port)
   fip = (Scheme_FD *)port->port_data;
 
   rc = adj_refcount(fip->refcount, -1);
-  if (!rc)
+  if (!rc) {
+    (void)scheme_rktio_fd_to_semaphore(fip->fd, MZFD_REMOVE);
     rktio_close(scheme_rktio, fip->fd);
-  else
+  } else
     rktio_forget(scheme_rktio, fip->fd);
 }
 
@@ -5310,9 +5311,10 @@ fd_close_output(Scheme_Output_Port *port)
 
   rc = adj_refcount(fop->refcount, -1);
   if (fop->fd) {
-    if (!rc)
+    if (!rc) {
+      (void)scheme_rktio_fd_to_semaphore(fop->fd, MZFD_REMOVE);
       rktio_close(scheme_rktio, fop->fd);
-    else
+    } else
       rktio_forget(scheme_rktio, fop->fd);
   }
 }