[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/01: Flush when getting string from r6rs string output
From: |
Andy Wingo |
Subject: |
[Guile-commits] 01/01: Flush when getting string from r6rs string output port |
Date: |
Mon, 6 Mar 2017 14:49:30 -0500 (EST) |
wingo pushed a commit to branch stable-2.0
in repository guile.
commit 73d9d1848850802f091ec9a8a69ba57c7e6702a0
Author: Andy Wingo <address@hidden>
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.
(cherry picked from commit e13cd5c77c030f22e3f5c27f15bb979bfda7d2ba)
---
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 c1484cb..8f4c312 100644
--- a/module/rnrs/io/ports.scm
+++ b/module/rnrs/io/ports.scm
@@ -354,7 +354,11 @@ as a string, and a thunk to retrieve the characters
associated with that port."
(let ((port (with-fluids ((%default-port-encoding "UTF-8"))
(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 7bf9ffa..318c279 100644
--- a/test-suite/tests/r6rs-ports.test
+++ b/test-suite/tests/r6rs-ports.test
@@ -728,6 +728,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)))