Implement R6RS output-port-buffer-mode

* module/rnrs/io/ports.scm (r6rs-open): Set buffer-mode on new port.
  (output-port-buffer-mode): Implement and export.
* module/rnrs.scm (rnrs): Export output-port-buffer-mode
* test-suite/tests/r6rs-ports.test (test-output-file-opener): Add
  tests.

module/rnrs.scm

@@ -183,7 +183,7 @@
           open-file-input-port open-file-output-port open-file-input/output-port
           make-custom-textual-output-port
           call-with-string-output-port
-	  flush-output-port put-string
+	  output-port-buffer-mode flush-output-port put-string
           get-char get-datum get-line get-string-all get-string-n get-string-n!
           lookahead-char
           put-char put-datum put-string

module/rnrs/io/ports.scm

@@ -63,6 +63,7 @@
           call-with-bytevector-output-port
           call-with-string-output-port
           make-custom-textual-output-port
+          output-port-buffer-mode
           flush-output-port
 
           ;; input/output ports
@@ -106,6 +107,9 @@
           make-i/o-encoding-error i/o-encoding-error-char)
   (import (ice-9 binary-ports)
           (only (rnrs base) assertion-violation)
+          (only (ice-9 ports internal)
+                port-write-buffer port-buffer-bytevector port-line-buffered?)
+          (only (rnrs bytevectors) bytevector-length)
           (rnrs enums)
           (rnrs records syntactic)
           (rnrs exceptions)
@@ -310,8 +314,9 @@ read from/written to in @var{port}."
                 (lambda ()
                   (with-fluids ((%default-port-encoding #f))
                     (open filename mode))))))
-    (cond (transcoder
+    (setvbuf port buffer-mode)
-           (set-port-encoding! port (transcoder-codec transcoder))))
+    (when transcoder
+      (set-port-encoding! port (transcoder-codec transcoder)))
     port))
 
 (define (file-options->mode file-options base-mode)
@@ -382,6 +387,16 @@ return the characters accumulated in that port."
                           close)
                   "w"))
 
+(define (output-port-buffer-mode port)
+  "Return @code{none} if @var{port} is unbuffered, @code{line} if it is
+line buffered, or @code{block} otherwise."
+  (let ((buffering (bytevector-length
+                    (port-buffer-bytevector (port-write-buffer port)))))
+    (cond
+     ((= buffering 1) 'none)
+     ((port-line-buffered? port) 'line)
+     (else 'block))))
+
 (define (flush-output-port port)
   (force-output port))
 

test-suite/tests/r6rs-ports.test

@@ -716,6 +716,24 @@ not `set-port-position!'"
                binary-port?)
              (= 0 (stat:size (stat filename)))))
     
+  (pass-if "buffer-mode none"
+           (call-with-port (open filename (file-options no-fail)
+                                 (buffer-mode none))
+             (lambda (port)
+               (eq? (output-port-buffer-mode port) 'none))))
+
+  (pass-if "buffer-mode line"
+           (call-with-port (open filename (file-options no-fail)
+                                 (buffer-mode line))
+             (lambda (port)
+               (eq? (output-port-buffer-mode port) 'line))))
+
+  (pass-if "buffer-mode block"
+           (call-with-port (open filename (file-options no-fail)
+                                 (buffer-mode block))
+             (lambda (port)
+               (eq? (output-port-buffer-mode port) 'block))))
+
   (delete-file filename)
     
   (pass-if-condition "exception: does-not-exist"