diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm
index e924ad8fc..594606785 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 94d9fc072..ba3131f2e 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)))