Add a "close" operation to non-channel output sinks.

diff --git a/src/runtime/binary-port.scm b/src/runtime/binary-port.scm
index 3c500708f01df8b99346bdce24208ce58b2f055f..34466a09c7b133764aef38efdd5d24ea655f62f7 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 custom)
   (let ((port #f)
        (open? #t))
     (make-source/sink flavor
@@ -757,7 +757,7 @@ USA.
                   (lambda (bv bs be) (channel-read channel bv bs be))))
 
 (define (make-non-channel-input-source has-bytes? read-bytes! . custom)
-  (apply make-non-channel-ss 'source has-bytes? read-bytes! custom))
+  (make-non-channel-ss 'source has-bytes? read-bytes! custom))
 
 (define (input-source? object)
   (and (source/sink? object)
@@ -790,10 +790,11 @@ USA.
 (define (make-channel-output-sink channel)
   (make-channel-ss 'sink
                   channel
-                  (lambda (bv bs be) (channel-write channel bv bs be))))
+                  (lambda (bv bs be) (channel-write channel bv bs be))
+                  (lambda () unspecific)))
 
-(define (make-non-channel-output-sink write-bytes . custom)
-  (apply make-non-channel-ss 'sink write-bytes custom))
+(define (make-non-channel-output-sink write-bytes close . custom)
+  (make-non-channel-ss 'sink write-bytes close custom))
 
 (define (output-sink? object)
   (and (source/sink? object)
@@ -807,13 +808,16 @@ 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)) 1))
+  (fix:- (vector-length (source/sink-custom sink)) 2))
 
 (define (output-sink-custom-ref sink index)
-  (vector-ref (source/sink-custom sink) (fix:+ index 1)))
\ No newline at end of file
+  (vector-ref (source/sink-custom sink) (fix:+ index 2)))
\ No newline at end of file

diff --git a/src/runtime/stringio.scm b/src/runtime/stringio.scm
index 27d00f90d3ab8cb07e8b2508e7c75e4408e05d11..fdb765a60cdf4e5d261469230b3d5f42ee661d13 100644 (file)
--- a/src/runtime/stringio.scm
+++ b/src/runtime/stringio.scm
@@ -277,7 +277,9 @@ USA.
        (do ((i start (fix:+ i 1)))
           ((not (fix:< i end)))
         (builder (integer->char (bytevector-u8-ref bv i)))))
-     (fix:- end start))))
+     (fix:- end start))
+   (lambda ()
+     unspecific)))
 
 (define (make-octets-output-type)
   (make-textual-port-type `((extract-output ,string-out/extract-output)