Fix previous change to add close operation to non-channel sink.

Also add support for sources.

diff --git a/src/runtime/binary-port.scm b/src/runtime/binary-port.scm
index 34466a09c7b133764aef38efdd5d24ea655f62f7..a7723631304351a322278121e4e8a9f828cc19d8 100644 (file)
--- a/src/runtime/binary-port.scm
+++ b/src/runtime/binary-port.scm
@@ -725,7 +725,7 @@ USA.
                    (lambda () unspecific)
                    (list->vector custom)))
 
-(define (make-non-channel-ss flavor custom)
+(define (make-non-channel-ss flavor close . custom)
   (let ((port #f)
        (open? #t))
     (make-source/sink flavor
@@ -733,7 +733,14 @@ USA.
                      (lambda () port)
                      (lambda (port*) (set! port port*) unspecific)
                      (lambda () open?)
-                     (lambda () (set! open? #f) unspecific)
+                     (if (default-object? close)
+                         (lambda ()
+                           (set! open? #f)
+                           unspecific)
+                         (lambda ()
+                           (close)
+                           (set! open? #f)
+                           unspecific))
                      (list->vector custom))))
 
 (define (source/sink-port source/sink)
@@ -756,8 +763,9 @@ USA.
                   (lambda () (channel-has-input? channel))
                   (lambda (bv bs be) (channel-read channel bv bs be))))
 
-(define (make-non-channel-input-source has-bytes? read-bytes! . custom)
-  (make-non-channel-ss 'source has-bytes? read-bytes! custom))
+(define (make-non-channel-input-source has-bytes? read-bytes!
+                                      #!optional close . custom)
+  (apply make-non-channel-ss 'source close has-bytes? read-bytes! custom))
 
 (define (input-source? object)
   (and (source/sink? object)
@@ -793,8 +801,8 @@ USA.
                   (lambda (bv bs be) (channel-write channel bv bs be))
                   (lambda () unspecific)))
 
-(define (make-non-channel-output-sink write-bytes close . custom)
-  (make-non-channel-ss 'sink write-bytes close custom))
+(define (make-non-channel-output-sink write-bytes #!optional close . custom)
+  (apply make-non-channel-ss 'sink close write-bytes custom))
 
 (define (output-sink? object)
   (and (source/sink? object)
@@ -808,16 +816,13 @@ USA.
 (define output-sink-port source/sink-port)
 (define set-output-sink-port! set-source/sink-port!)
 (define output-sink-open? source/sink-open?)
+(define close-output-sink close-source/sink)
 
 (define (output-sink-write-bytes sink bv bs be)
   ((vector-ref (source/sink-custom sink) 0) bv bs be))
 
-(define (close-output-sink sink)
-  ((vector-ref (source/sink-custom sink) 1))
-  (close-source/sink sink))
-
 (define (output-sink-custom-length sink)
-  (fix:- (vector-length (source/sink-custom sink)) 2))
+  (fix:- (vector-length (source/sink-custom sink)) 1))
 
 (define (output-sink-custom-ref sink index)
-  (vector-ref (source/sink-custom sink) (fix:+ index 2)))
\ No newline at end of file
+  (vector-ref (source/sink-custom sink) (fix:+ index 1)))
\ No newline at end of file