When closing an output port, capture any errors while flushing the
port and try to close the port immediately instead.
This commit is contained in:
parent
804362834b
commit
6a8b7f6145
|
@ -181,6 +181,13 @@
|
|||
((port-handler-close (port-handler port)) (port-data port))))))
|
||||
(call-error "invalid argument" close-input-port port)))
|
||||
|
||||
;; Flushing the port may raise an error. If the port is marked closed
|
||||
;; before, subsequent calls will never close the underlying channel.
|
||||
;; This installs an error handler before calling REALLY-FORCE-OUTPUT,
|
||||
;; the handler will try to close the port and raise the error
|
||||
;; afterwards. The inner close has an additional error handler which
|
||||
;; will invoke the original handler.
|
||||
|
||||
(define (close-output-port port)
|
||||
(if (output-port? port)
|
||||
(protect-port-op
|
||||
|
@ -189,7 +196,16 @@
|
|||
(if (open-output-port? port)
|
||||
(begin
|
||||
(make-output-port-closed! port)
|
||||
(really-force-output port)
|
||||
(with-handler
|
||||
(lambda (condition more)
|
||||
(with-handler
|
||||
(lambda (cond2 more2)
|
||||
(more))
|
||||
(lambda ()
|
||||
((port-handler-close (port-handler port)) (port-data port))
|
||||
(more))))
|
||||
(lambda ()
|
||||
(really-force-output port)))
|
||||
((port-handler-close (port-handler port)) (port-data port))))))
|
||||
(call-error "invalid argument" close-output-port port)))
|
||||
|
||||
|
|
Loading…
Reference in New Issue