From 9824c0fed439e5948d4fbc3e338dba5b79deb6d9 Mon Sep 17 00:00:00 2001
From: Bob Burger <bburger@indigobio.com>
Date: Thu, 16 Apr 2026 15:21:43 -0400
Subject: [PATCH] eagerly close file port when open-source-file fails on a
 non-seekable device

---
 release_notes/release_notes.stex |  6 ++++++
 s/read.ss                        | 15 ++++++++-------
 2 files changed, 14 insertions(+), 7 deletions(-)

diff --git a/release_notes/release_notes.stex b/release_notes/release_notes.stex
index 0d0d63d87..7980eb7cb 100644
--- a/release_notes/release_notes.stex
+++ b/release_notes/release_notes.stex
@@ -2987,6 +2987,12 @@ in fasl files does not generally make sense.
 %-----------------------------------------------------------------------------
 \section{Bug Fixes}\label{section:bugfixes}
 
+\subsection{Eager port closing on error in \scheme{open-source-file} (10.4.0)}
+
+When \scheme{open-source-file} fails on a non-seekable device, the file descriptor port
+was kept open until the garbage collector eventually closed it. It now closes the port on
+error.
+
 \subsection{Signals in non-Scheme threads (10.4.0)}
 
 A bug in threaded Chez Scheme where some signals raised in non-Scheme threads could cause
diff --git a/s/read.ss b/s/read.ss
index 2a01351a5..21923c597 100644
--- a/s/read.ss
+++ b/s/read.ss
@@ -1720,13 +1720,14 @@
               (set! paths-tried (cons path paths-tried))
               (guard (c [#t #f])
                 (let ([ip ($open-file-input-port '$open-source-file path)])
-                  (if (let ([new-sfd ($source-file-descriptor path ip)])
-                         (and (fx= (source-file-descriptor-crc new-sfd)
-                                   (source-file-descriptor-crc sfd))
-                              (= (source-file-descriptor-length new-sfd)
-                                 (source-file-descriptor-length sfd))))
-                       (transcoded-port ip (current-transcoder))
-                       (begin (close-input-port ip) #f)))))))))
+                  (guard (c [#t (close-input-port ip) #f])
+                    (if (let ([new-sfd ($source-file-descriptor path ip)])
+                          (and (fx= (source-file-descriptor-crc new-sfd)
+                                    (source-file-descriptor-crc sfd))
+                               (= (source-file-descriptor-length new-sfd)
+                                  (source-file-descriptor-length sfd))))
+                        (transcoded-port ip (current-transcoder))
+                        (begin (close-input-port ip) #f))))))))))
     (define (search name dir*)
       (and (not (null? dir*))
            (or (source-port