From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 24 Apr 2017 07:23:22 +0000 (-0700)
Subject: Add a "close" operation to non-channel output sinks.
X-Git-Tag: mit-scheme-pucked-9.2.12~153^2~15
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=9b355adcaf0135fa1b4d6d9b2a22d1561d595cdc;p=mit-scheme.git

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

diff --git a/src/runtime/binary-port.scm b/src/runtime/binary-port.scm
index 3c500708f..34466a09c 100644
--- 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 27d00f90d..fdb765a60 100644
--- 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)