wingo pushed a commit to branch master in repository guile. commit e13cd5c77c030f22e3f5c27f15bb979bfda7d2ba Author: Andy Wingo <wi...@pobox.com> Date: Wed Mar 1 14:24:41 2017 +0100
Flush when getting string from r6rs string output port * module/rnrs/io/ports.scm (open-string-output-port): Calling the get-string proc should flush the buffer and reset the file position. * test-suite/tests/r6rs-ports.test ("8.2.10 Output ports"): Add tests. Thanks to Freja Nordsiek for the report. --- module/rnrs/io/ports.scm | 6 +++++- test-suite/tests/r6rs-ports.test | 15 +++++++++++++++ 2 files changed, 20 insertions(+), 1 deletion(-) diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm index e924ad8..5946067 100644 --- a/module/rnrs/io/ports.scm +++ b/module/rnrs/io/ports.scm @@ -387,7 +387,11 @@ read from/written to in @var{port}." as a string, and a thunk to retrieve the characters associated with that port." (let ((port (open-output-string))) (values port - (lambda () (get-output-string port))))) + (lambda () + (let ((s (get-output-string port))) + (seek port 0 SEEK_SET) + (truncate-file port 0) + s))))) (define* (open-file-output-port filename #:optional diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test index 94d9fc0..ba3131f 100644 --- a/test-suite/tests/r6rs-ports.test +++ b/test-suite/tests/r6rs-ports.test @@ -745,6 +745,21 @@ not `set-port-position!'" (with-test-prefix "open-file-output-port" (test-output-file-opener open-file-output-port (test-file))) + (pass-if "open-string-output-port" + (call-with-values open-string-output-port + (lambda (port proc) + (and (port? port) (thunk? proc))))) + + (pass-if-equal "calling string output port truncates port" + '("hello" "" "world") + (call-with-values open-string-output-port + (lambda (port proc) + (display "hello" port) + (let* ((s1 (proc)) + (s2 (proc))) + (display "world" port) + (list s1 s2 (proc)))))) + (pass-if "open-bytevector-output-port" (let-values (((port get-content) (open-bytevector-output-port #f)))