From 0df24a96cf158f456f1d5e5294e8a944361ced6f Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Wed, 11 Mar 2026 19:17:40 +0300 Subject: [PATCH] Don't add finalizers to streams opened via with-open-file They are going to be closed in unwind-protect. Suggested by John Mallery. --- contrib/sb-simple-streams/fndb.lisp | 3 ++- contrib/sb-simple-streams/impl.lisp | 6 ++++-- contrib/sb-simple-streams/internal.lisp | 13 ++++++------ src/code/fd-stream.lisp | 28 +++++++++++++------------ src/code/macros.lisp | 4 +++- src/compiler/fndb.lisp | 1 + xperfecthash63.lisp-expr | 3 +++ 7 files changed, 35 insertions(+), 23 deletions(-) diff --git a/contrib/sb-simple-streams/fndb.lisp b/contrib/sb-simple-streams/fndb.lisp index 3b39639e6..cbf8688cc 100644 --- a/contrib/sb-simple-streams/fndb.lisp +++ b/contrib/sb-simple-streams/fndb.lisp @@ -78,7 +78,8 @@ TODO (rudi 2003-05-19): make the above work, make (defknown open) use it. (:mapped (member t nil)) (:input-handle (or null fixnum stream)) (:output-handle (or null fixnum stream)) - #+win32 (:overlapped t)) + #+win32 (:overlapped t) + (:auto-close t)) (or stream null) () ;; :derive-type #'result-type-open-class diff --git a/contrib/sb-simple-streams/impl.lisp b/contrib/sb-simple-streams/impl.lisp index 374ba48c8..e6bf4da7b 100644 --- a/contrib/sb-simple-streams/impl.lisp +++ b/contrib/sb-simple-streams/impl.lisp @@ -605,7 +605,8 @@ if-exists if-does-not-exist (external-format :default) class mapped input-handle output-handle - #+win32 (overlapped t)) + #+win32 (overlapped t) + (auto-close t)) "Return a stream which reads from or writes to Filename. Defined keywords: :direction - one of :input, :output, :io, or :probe @@ -622,7 +623,7 @@ :input-handle - a stream or Unix file descriptor to read from :output-handle - a stream or Unix file descriptor to write to" (declare (ignore element-type external-format input-handle output-handle - #+win32 overlapped + #+win32 overlapped auto-close if-exists if-does-not-exist)) (let ((class (or class 'sb-sys:fd-stream)) (options (copy-list options)) @@ -642,6 +643,7 @@ (when (subtypep class 'file-simple-stream) (when (eq direction :probe) (setq class 'probe-simple-stream))) + (remf options :auto-close) (apply #'make-instance class :filename filespec options)) ((subtypep class 'sb-gray:fundamental-stream) (remf options :class) diff --git a/contrib/sb-simple-streams/internal.lisp b/contrib/sb-simple-streams/internal.lisp index 15dcf37ba..82217039f 100644 --- a/contrib/sb-simple-streams/internal.lisp +++ b/contrib/sb-simple-streams/internal.lisp @@ -626,11 +626,12 @@ (return nil))))))))) (defun open-fd-stream (pathname &key (class 'sb-sys:fd-stream) - (direction :input) - (element-type 'base-char) - (if-exists nil if-exists-given) - (if-does-not-exist nil if-does-not-exist-given) - (external-format :default)) + (direction :input) + (element-type 'base-char) + (if-exists nil if-exists-given) + (if-does-not-exist nil if-does-not-exist-given) + (external-format :default) + (auto-close t)) (declare (type (or pathname string stream) pathname) (type (member :input :output :io :probe) direction) (type (member :error :new-version :rename :rename-and-delete @@ -654,7 +655,7 @@ :pathname pathname :dual-channel-p nil :input-buffer-p t - :auto-close t + :auto-close auto-close :external-format external-format)) (:probe (let ((stream (sb-impl::%make-fd-stream :name namestring :fd fd diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index 13c66937f..986ef55e8 100644 --- a/src/code/fd-stream.lisp +++ b/src/code/fd-stream.lisp @@ -2253,17 +2253,18 @@ "~@" file fd-stream))))))) (t (finish-fd-stream-output fd-stream) - (let ((orig (fd-stream-original fd-stream))) - (when (and orig (fd-stream-delete-original fd-stream)) - (multiple-value-bind (okay err) (sb-unix:unix-unlink orig) - (unless okay - (file-perror - orig err - "~@" orig fd-stream))))) - ;; In case of no-abort close, don't *really* close the - ;; stream until the last moment -- the cleaning up of the - ;; original can be done first. - (release-fd-stream-resources fd-stream)))) + (unwind-protect + (let ((orig (fd-stream-original fd-stream))) + (when (and orig (fd-stream-delete-original fd-stream)) + (multiple-value-bind (okay err) (sb-unix:unix-unlink orig) + (unless okay + (file-perror + orig err + "~@" orig fd-stream))))) + ;; In case of no-abort close, don't *really* close the + ;; stream until the last moment -- the cleaning up of the + ;; original can be done first. + (release-fd-stream-resources fd-stream))))) (:clear-input (fd-stream-clear-input fd-stream)) (:force-output @@ -2496,7 +2497,7 @@ (name (if file (format nil "file ~A" file) (format nil "descriptor ~W" fd))) - auto-close) + auto-close) (declare (type index fd) (type (or real null) timeout) (type (member :none :line :full) buffering)) ;; OPEN ensures that the external-format argument is OK before @@ -2631,6 +2632,7 @@ (external-format :default) ;; private options - use at your own risk (class 'fd-stream) + (auto-close t) #+win32 (overlapped t) &aux @@ -2802,7 +2804,7 @@ :dual-channel-p nil :serve-events nil :input-buffer-p t - :auto-close t)) + :auto-close auto-close)) (:probe (let ((stream (%make-fd-stream :name namestring diff --git a/src/code/macros.lisp b/src/code/macros.lisp index e13b61539..e7cb659a3 100644 --- a/src/code/macros.lisp +++ b/src/code/macros.lisp @@ -1426,6 +1426,8 @@ invoked. In that case it will store into PLACE and start over." ;;;; WITH-FOO i/o-related macros (sb-xc:defmacro with-open-stream ((var stream) &body body) + (when (typep stream '(cons (eql open) (cons t))) + (setf stream `(open ,@(cdr stream) :auto-close nil))) (multiple-value-bind (forms decls) (parse-body body nil) `(let ((,var ,stream)) ,@decls @@ -1437,7 +1439,7 @@ invoked. In that case it will store into PLACE and start over." &body body) (multiple-value-bind (forms decls) (parse-body body nil) (let ((abortp (gensym))) - `(let ((,stream (open ,filespec ,@options)) + `(let ((,stream (open ,filespec ,@options :auto-close nil)) (,abortp t)) ,@decls (unwind-protect diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index 6cb6d673e..0a4741114 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -1912,6 +1912,7 @@ :append :supersede nil)) (:if-does-not-exist (member :error :create nil)) (:external-format external-format-designator) + (:auto-close t) #+win32 (:overlapped t)) (or stream null)) diff --git a/xperfecthash63.lisp-expr b/xperfecthash63.lisp-expr index 5b3e73178..ca6e5fb8c 100644 --- a/xperfecthash63.lisp-expr +++ b/xperfecthash63.lisp-expr @@ -1697,5 +1697,8 @@ (#(28 2A 2C 2E 30 32 34 36) "((21 FLOATING-POINT-OVERFLOW) (20 DIVISION-BY-ZERO) (22 DIVISION-BY-ZERO 4294966779) (23 FLOATING-POINT-OVERFLOW 4294966263) (24 FLOATING-POINT-UNDERFLOW 4294965231) (25 FLOATING-POINT-INEXACT 4294963167) (26 FLOATING-POINT-INVALID-OPERATION 4294967166) (27 FLOATING-POINT-EXCEPTION))" "((& (>> val 1) 7))") +(#(1588B4F0 2A4B00C6 2B465CCD 42D83FFB 96A5F5BD B8D32AF5 ECF81B20 FA4BD0D1) + "(:ALLOW-OTHER-KEYS :AUTO-CLOSE :CLASS :EXTERNAL-FORMAT :IF-DOES-NOT-EXIST :IF-EXISTS :ELEMENT-TYPE :DIRECTION)" + "((& (^ val (>> val 9)) 7))") ) ;; EOF