From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 25 Apr 2017 03:55:15 +0000 (-0700)
Subject: Fix previous change to add close operation to non-channel sink.
X-Git-Tag: mit-scheme-pucked-9.2.12~153^2~13
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=4459d51f149a26cf34e473db70bd001bc3ac6bc2;p=mit-scheme.git

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 34466a09c..a77236313 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 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