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:
mainzelm 2003-01-08 09:26:58 +00:00
parent 804362834b
commit 6a8b7f6145
1 changed files with 17 additions and 1 deletions

View File

@ -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)))