~ chicken-core (chicken-5) 0d58b23e75fc90a85eb8f431d10bc66a66344a33

commit 0d58b23e75fc90a85eb8f431d10bc66a66344a33
Author:     Peter Bex <peter.bex@xs4all.nl>
AuthorDate: Sat Jun 8 17:35:03 2013 +0200
Commit:     Christian Kellermann <ckeen@pestilenz.org>
CommitDate: Sun Jun 16 21:49:18 2013 +0200

    Do not reset string size upon closing a string output port
    
    Signed-off-by: Christian Kellermann <ckeen@pestilenz.org>

diff --git a/library.scm b/library.scm
index 31ee708c..87c6e838 100644
--- a/library.scm
+++ b/library.scm
@@ -3556,8 +3556,7 @@ EOF
 	       [output (##sys#slot p 12)] )
 	   (##core#inline "C_substring_copy" str output 0 len position)
 	   (##sys#setislot p 10 (fx+ position len)) ) ) )
-     (lambda (p)			; close
-       (##sys#setislot p 10 (##sys#slot p 11)) )
+     void ; close
      (lambda (p) #f)			; flush-output
      (lambda (p)			; char-ready?
        (fx< (##sys#slot p 10) (##sys#slot p 11)) )
diff --git a/tests/port-tests.scm b/tests/port-tests.scm
index ca334e98..409c552a 100644
--- a/tests/port-tests.scm
+++ b/tests/port-tests.scm
@@ -42,6 +42,17 @@ EOF
   (read-line p)))
 (assert (= 20 (length (read-lines (open-input-string *text*)))))
 
+(let ((out (open-output-string)))
+  (test-equal "Initially, output string is empty"
+              (get-output-string out) "")
+  (display "foo" out)
+  (test-equal "output can be extracted from output string"
+              (get-output-string out) "foo")
+  (close-output-port out)
+  (test-equal "closing a string output port has no effect on the returned data"
+              (get-output-string out) "foo")
+  (test-error "writing to a closed string output port is an error"
+              (display "bar" out)))
 
 ;;; copy-port
 
@@ -303,3 +314,5 @@ EOF
  (test-port-position read-tcp-line/pos))
 
 ;;;
+
+(test-end)