From 6dce942c46494460369b8a93d3c657e1f6e57fed Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Wed, 7 Aug 2013 00:46:34 -0400
Subject: [PATCH] String ports use UTF-8; ignore %default-port-encoding.

* libguile/strports.c (scm_mkstrport): Use UTF-8; ignore
  %default-port-encoding.  Rename 'str_len' and 'c_pos' to
  'num_bytes' and 'c_byte_pos'.  Interpret 'pos' argument
  as a character index instead of a byte index.

* module/ice-9/boot-9.scm (%cond-expand-features): Add srfi-6 to the
  list of core features.

* module/srfi/srfi-6.scm (open-input-string, open-output-string): Simply
  re-export these, since the core versions are now compliant.

* doc/ref/api-io.texi (String Ports): Remove text that describes
  non-compliant behavior of string ports with regard to encoding.

* doc/ref/srfi-modules.texi (SRFI-0): Add srfi-6 to the list of
  core features.
  (SRFI-6): Remove text that mentions non-compliant behavior of
  core string ports.

* module/ice-9/format.scm (format):
* module/ice-9/pretty-print.scm (truncated-print):
* module/rnrs/io/ports.scm (open-string-input-port,
  open-string-output-port):
* test-suite/test-suite/lib.scm (format-test-name):
* test-suite/tests/chars.test ("combining accent is pretty-printed",
  "combining X is pretty-printed"):
* test-suite/tests/ecmascript.test (eread, eread/1):
* test-suite/tests/rdelim.test:
* test-suite/tests/reader.test (read-string):
* test-suite/tests/regexp.test:
* test-suite/tests/srfi-105.test (read-string): Don't set
  %default-port-encoding before creating string ports.

* benchmark-suite/benchmarks/ports.bm (%latin1-port): Use
  'set-port-encoding!' to set the string port encoding.
  (%utf8/ascii-port, %utf8/wide-port, "rdelim"): Don't set
  %default-port-encoding before creating string ports.

* test-suite/tests/r6rs-ports.test ("lookahead-u8 non-ASCII"): Don't set
  %default-port-encoding before creating string ports.
  ("put-bytevector with UTF-16 string port", "put-bytevector with
  wrong-encoding string port"): Use 'set-port-encoding!' to set the
  string port encoding.

* test-suite/tests/print.test (tprint): Use 'set-port-encoding!' to set
  the string port encoding.
  ("truncated-print"): Use 'pass-if-equal'.

* test-suite/tests/ports.test ("encoding failure leads to exception",
  "%default-port-encoding is honored", "peek-char [latin-1]", "peek-char
  [utf-8]", "peek-char [utf-16]"): Remove tests.
  ("%default-port-encoding is ignored", "peek-char"): Add tests.
  ("suitable encoding [latin-1]", "suitable encoding [latin-3]",
  "wrong encoding, error", "wrong encoding, substitute",
  "wrong encoding, escape"): Use 'set-port-encoding!' to set the
  string port encoding.
  ("%default-port-encoding, wrong encoding"): Rewrite to use
  a file port instead of a string port.
---
 benchmark-suite/benchmarks/ports.bm |  16 +-
 doc/ref/api-io.texi                 |  24 --
 doc/ref/srfi-modules.texi           |  19 +-
 libguile/strports.c                 |  39 +--
 module/ice-9/boot-9.scm             |   4 +-
 module/ice-9/format.scm             |   7 +-
 module/ice-9/pretty-print.scm       | 274 ++++++++++-----------
 module/rnrs/io/ports.scm            |   6 +-
 module/srfi/srfi-6.scm              |  20 +-
 test-suite/test-suite/lib.scm       |  21 +-
 test-suite/tests/chars.test         |   8 +-
 test-suite/tests/ecmascript.test    |   6 +-
 test-suite/tests/ports.test         | 137 ++++-------
 test-suite/tests/print.test         |  42 ++--
 test-suite/tests/r6rs-ports.test    |  21 +-
 test-suite/tests/rdelim.test        | 368 ++++++++++++++--------------
 test-suite/tests/reader.test        |   6 +-
 test-suite/tests/regexp.test        |  18 +-
 test-suite/tests/srfi-105.test      |   5 +-
 19 files changed, 468 insertions(+), 573 deletions(-)

diff --git a/benchmark-suite/benchmarks/ports.bm b/benchmark-suite/benchmarks/ports.bm
index 630ece290..0b1d7f5f3 100644
--- a/benchmark-suite/benchmarks/ports.bm
+++ b/benchmark-suite/benchmarks/ports.bm
@@ -1,6 +1,6 @@
 ;;; ports.bm --- Port I/O.         -*- mode: scheme; coding: utf-8; -*-
 ;;;
-;;; Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc.
+;;; Copyright (C) 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public License
@@ -34,16 +34,15 @@
   (string-concatenate (make-list (* iteration-factor 10000) s)))
 
 (define %latin1-port
-  (with-fluids ((%default-port-encoding #f))
-    (open-input-string (large-string "hello, world"))))
+  (let ((p (open-input-string (large-string "hello, world"))))
+    (set-port-encoding! p "ISO-8859-1")
+    p))
 
 (define %utf8/ascii-port
-  (with-fluids ((%default-port-encoding "UTF-8"))
-    (open-input-string (large-string "hello, world"))))
+  (open-input-string (large-string "hello, world")))
 
 (define %utf8/wide-port
-  (with-fluids ((%default-port-encoding "UTF-8"))
-    (open-input-string (large-string "안녕하세요"))))
+  (open-input-string (large-string "안녕하세요")))
 
 
 (with-benchmark-prefix "peek-char"
@@ -87,6 +86,5 @@
 
   (let ((str (string-concatenate (make-list 1000 "one line\n"))))
     (benchmark "read-line" 1000
-               (let ((port (with-fluids ((%default-port-encoding "UTF-8"))
-                             (open-input-string str))))
+               (let ((port (open-input-string str)))
                  (sequence (read-line port) 1000)))))
diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi
index 4c42de8d0..8e3d40a69 100644
--- a/doc/ref/api-io.texi
+++ b/doc/ref/api-io.texi
@@ -1066,28 +1066,6 @@ away from its default.
 Calls the one-argument procedure @var{proc} with a newly created output
 port.  When the function returns, the string composed of the characters
 written into the port is returned.  @var{proc} should not close the port.
-
-Note that which characters can be written to a string port depend on the port's
-encoding.  The default encoding of string ports is specified by the
-@code{%default-port-encoding} fluid (@pxref{Ports,
-@code{%default-port-encoding}}).  For instance, it is an error to write Greek
-letter alpha to an ISO-8859-1-encoded string port since this character cannot be
-represented with ISO-8859-1:
-
-@example
-(define alpha (integer->char #x03b1)) ; GREEK SMALL LETTER ALPHA
-
-(with-fluids ((%default-port-encoding "ISO-8859-1"))
-  (call-with-output-string
-    (lambda (p)
-      (display alpha p))))
-
-@result{}
-Throw to key `encoding-error'
-@end example
-
-Changing the string port's encoding to a Unicode-capable encoding such as UTF-8
-solves the problem.
 @end deffn
 
 @deffn {Scheme Procedure} call-with-input-string string proc
@@ -1101,8 +1079,6 @@ read.  The value yielded by the @var{proc} is returned.
 Calls the zero-argument procedure @var{thunk} with the current output
 port set temporarily to a new string port.  It returns a string
 composed of the characters written to the current output.
-
-See @code{call-with-output-string} above for character encoding considerations.
 @end deffn
 
 @deffn {Scheme Procedure} with-input-from-string string thunk
diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi
index f0158d5e8..d97f49820 100644
--- a/doc/ref/srfi-modules.texi
+++ b/doc/ref/srfi-modules.texi
@@ -146,6 +146,7 @@ guile-2  ;; starting from Guile 2.x
 r5rs
 srfi-0
 srfi-4
+srfi-6
 srfi-13
 srfi-14
 srfi-23
@@ -1851,19 +1852,11 @@ uniform numeric vector, it is returned unchanged.
 @cindex SRFI-6
 
 SRFI-6 defines the procedures @code{open-input-string},
-@code{open-output-string} and @code{get-output-string}.
-
-Note that although versions of these procedures are included in the
-Guile core, the core versions are not fully conformant with SRFI-6:
-attempts to read or write characters that are not supported by the
-current @code{%default-port-encoding} will fail.
-
-We therefore recommend that you import this module, which supports all
-characters:
-
-@example
-(use-modules (srfi srfi-6))
-@end example
+@code{open-output-string} and @code{get-output-string}.  These
+procedures are included in the Guile core, so using this module does not
+make any difference at the moment.  But it is possible that support for
+SRFI-6 will be factored out of the core library in the future, so using
+this module does not hurt, after all.
 
 @node SRFI-8
 @subsection SRFI-8 - receive
diff --git a/libguile/strports.c b/libguile/strports.c
index 40f656e4b..f10ede962 100644
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -251,57 +251,60 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
 {
   SCM z, buf;
   scm_t_port *pt;
-  const char *encoding;
-  size_t read_buf_size, str_len, c_pos;
+  size_t read_buf_size, num_bytes, c_byte_pos;
   char *c_buf;
 
   if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG)))
     scm_misc_error ("scm_mkstrport", "port must read or write", SCM_EOL);
 
-  encoding = scm_i_default_port_encoding ();
-
   if (scm_is_false (str))
     {
       /* Allocate a new buffer to write to.  */
-      str_len = INITIAL_BUFFER_SIZE;
-      buf = scm_c_make_bytevector (str_len);
+      num_bytes = INITIAL_BUFFER_SIZE;
+      buf = scm_c_make_bytevector (num_bytes);
       c_buf = (char *) SCM_BYTEVECTOR_CONTENTS (buf);
 
       /* Reset `read_buf_size'.  It will contain the actual number of
 	 bytes written to the port.  */
       read_buf_size = 0;
-      c_pos = 0;
+      c_byte_pos = 0;
     }
   else
     {
-      /* STR is a string.  */
       char *copy;
 
       SCM_ASSERT (scm_is_string (str), str, SCM_ARG1, caller);
 
-      /* Create a copy of STR in ENCODING.  */
-      copy = scm_to_stringn (str, &str_len, encoding,
-			     SCM_FAILED_CONVERSION_ERROR);
-      buf = scm_c_make_bytevector (str_len);
+      /* STR is a string.  */
+      /* Create a copy of STR in UTF-8.  */
+      copy = scm_to_utf8_stringn (str, &num_bytes);
+      buf = scm_c_make_bytevector (num_bytes);
       c_buf = (char *) SCM_BYTEVECTOR_CONTENTS (buf);
-      memcpy (c_buf, copy, str_len);
+      memcpy (c_buf, copy, num_bytes);
       free (copy);
 
-      c_pos = scm_to_unsigned_integer (pos, 0, str_len);
-      read_buf_size = str_len;
+      read_buf_size = num_bytes;
+
+      if (scm_is_eq (pos, SCM_INUM0))
+        c_byte_pos = 0;
+      else
+        /* Inefficient but simple way to convert the character position
+           POS into a byte position C_BYTE_POS.  */
+        free (scm_to_utf8_stringn (scm_substring (str, SCM_INUM0, pos),
+                                   &c_byte_pos));
     }
 
   z = scm_c_make_port_with_encoding (scm_tc16_strport, modes,
-                                     encoding,
+                                     "UTF-8",
                                      scm_i_default_port_conversion_handler (),
                                      (scm_t_bits)buf);
 
   pt = SCM_PTAB_ENTRY (z);
 
   pt->write_buf = pt->read_buf = (unsigned char *) c_buf;
-  pt->read_pos = pt->write_pos = pt->read_buf + c_pos;
+  pt->read_pos = pt->write_pos = pt->read_buf + c_byte_pos;
   pt->read_buf_size = read_buf_size;
-  pt->write_buf_size = str_len;
+  pt->write_buf_size = num_bytes;
   pt->write_end = pt->read_end = pt->read_buf + pt->read_buf_size;
   pt->rw_random = 1;
 
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 8bf724824..30aabb9fc 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -4196,9 +4196,7 @@ when none is available, reading FILE-NAME with READER."
     r5rs
     srfi-0   ;; cond-expand itself
     srfi-4   ;; homogeneous numeric vectors
-    ;; We omit srfi-6 because the 'open-input-string' etc in Guile
-    ;; core are not conformant with SRFI-6; they expose details
-    ;; of the binary I/O model and may fail to support some characters.
+    srfi-6   ;; string ports
     srfi-13  ;; string library
     srfi-14  ;; character sets
     srfi-23  ;; `error` procedure
diff --git a/module/ice-9/format.scm b/module/ice-9/format.scm
index eed8cbb0e..1ef4cb5ef 100644
--- a/module/ice-9/format.scm
+++ b/module/ice-9/format.scm
@@ -1,5 +1,5 @@
 ;;;; "format.scm" Common LISP text output formatter for SLIB
-;;; 	Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc.
+;;; 	Copyright (C) 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
 ;;;
 ;;; This library is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public
@@ -42,10 +42,7 @@
 
   (let* ((port
           (cond
-           ((not destination)
-            ;; Use a Unicode-capable output string port.
-            (with-fluids ((%default-port-encoding "UTF-8"))
-              (open-output-string)))
+           ((not destination) (open-output-string))
            ((boolean? destination) (current-output-port)) ; boolean but not false
            ((output-port? destination) destination)
            ((number? destination)
diff --git a/module/ice-9/pretty-print.scm b/module/ice-9/pretty-print.scm
index 5c23cb009..1573c6fd5 100644
--- a/module/ice-9/pretty-print.scm
+++ b/module/ice-9/pretty-print.scm
@@ -1,7 +1,7 @@
 ;;;; -*- coding: utf-8; mode: scheme -*-
 ;;;;
 ;;;; 	Copyright (C) 2001, 2004, 2006, 2009, 2010,
-;;;;      2012 Free Software Foundation, Inc.
+;;;;      2012, 2013 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -311,142 +311,138 @@ e.g., if @var{x} is a vector, each member of @var{x}. One can attempt to
 \"ration\" the available width, trying to allocate it equally to each
 sub-expression, via the @var{breadth-first?} keyword argument."
 
-  ;; Make sure string ports are created with the right encoding.
-  (with-fluids ((%default-port-encoding (port-encoding port)))
-
-    (define ellipsis
-      ;; Choose between `HORIZONTAL ELLIPSIS' (U+2026) and three dots, depending
-      ;; on the encoding of PORT.
-      (let ((e "…"))
-        (catch 'encoding-error
-          (lambda ()
-            (with-fluids ((%default-port-conversion-strategy 'error))
-              (with-output-to-string
-                (lambda ()
-                  (display e)))))
-          (lambda (key . args)
-            "..."))))
-
-    (let ((ellipsis-width (string-length ellipsis)))
-
-      (define (print-sequence x width len ref next)
-        (let lp ((x x)
-                 (width width)
-                 (i 0))
-          (if (> i 0)
-              (display #\space))
-          (cond
-           ((= i len)) ; catches 0-length case
-           ((and (= i (1- len)) (or (zero? i) (> width 1)))
-            (print (ref x i) (if (zero? i) width (1- width))))
-           ((<= width (+ 1 ellipsis-width))
-            (display ellipsis))
-           (else
-            (let ((str
-                   (with-fluids ((%default-port-encoding (port-encoding port)))
-                     (with-output-to-string
-                           (lambda ()
-                             (print (ref x i)
-                                    (if breadth-first?
-                                        (max 1
-                                             (1- (floor (/ width (- len i)))))
-                                        (- width (+ 1 ellipsis-width)))))))))
-              (display str)
-              (lp (next x) (- width 1 (string-length str)) (1+ i)))))))
-
-      (define (print-tree x width)
-        ;; width is >= the width of # . #, which is 5
-        (let lp ((x x)
-                 (width width))
-          (cond
-           ((or (not (pair? x)) (<= width 4))
-            (display ". ")
-            (print x (- width 2)))
-           (else
-            ;; width >= 5
-            (let ((str (with-output-to-string
-                         (lambda ()
-                           (print (car x)
-                                  (if breadth-first?
-                                      (floor (/ (- width 3) 2))
-                                      (- width 4)))))))
-              (display str)
-              (display " ")
-              (lp (cdr x) (- width 1 (string-length str))))))))
-
-      (define (truncate-string str width)
-        ;; width is < (string-length str)
-        (let lp ((fixes '(("#<" . ">")
-                          ("#(" . ")")
-                          ("(" . ")")
-                          ("\"" . "\""))))
-          (cond
-           ((null? fixes)
-            "#")
-           ((and (string-prefix? (caar fixes) str)
-                 (string-suffix? (cdar fixes) str)
-                 (>= (string-length str)
-                     width
-                     (+ (string-length (caar fixes))
-                        (string-length (cdar fixes))
-                        ellipsis-width)))
-            (format #f "~a~a~a~a"
-                    (caar fixes)
-                    (substring str (string-length (caar fixes))
-                               (- width (string-length (cdar fixes))
-                                  ellipsis-width))
-                    ellipsis
-                    (cdar fixes)))
-           (else
-            (lp (cdr fixes))))))
-
-      (define (print x width)
-        (cond
-         ((<= width 0)
-          (error "expected a positive width" width))
-         ((list? x)
-          (cond
-           ((>= width (+ 2 ellipsis-width))
-            (display "(")
-            (print-sequence x (- width 2) (length x)
-                            (lambda (x i) (car x)) cdr)
-            (display ")"))
-           (else
-            (display "#"))))
-         ((vector? x)
-          (cond
-           ((>= width (+ 3 ellipsis-width))
-            (display "#(")
-            (print-sequence x (- width 3) (vector-length x)
-                            vector-ref identity)
-            (display ")"))
-           (else
-            (display "#"))))
-         ((uniform-vector? x)
-          (cond
-           ((>= width 9)
-            (format #t  "#~a(" (uniform-vector-element-type x))
-            (print-sequence x (- width 6) (uniform-vector-length x)
-                            uniform-vector-ref identity)
-            (display ")"))
-           (else
-            (display "#"))))
-         ((pair? x)
-          (cond
-           ((>= width (+ 4 ellipsis-width))
-            (display "(")
-            (print-tree x (- width 2))
-            (display ")"))
-           (else
-            (display "#"))))
-         (else
-          (let* ((str (with-output-to-string
-                        (lambda () (if display? (display x) (write x)))))
-                 (len (string-length str)))
-            (display (if (<= (string-length str) width)
-                         str
-                         (truncate-string str width)))))))
-
-      (with-output-to-port port
+  (define ellipsis
+    ;; Choose between `HORIZONTAL ELLIPSIS' (U+2026) and three dots, depending
+    ;; on the encoding of PORT.
+    (let ((e "…"))
+      (catch 'encoding-error
         (lambda ()
-          (print x width))))))
+          (with-fluids ((%default-port-conversion-strategy 'error))
+            (call-with-output-string
+             (lambda (p)
+               (set-port-encoding! p (port-encoding port))
+               (display e p)))))
+        (lambda (key . args)
+          "..."))))
+
+  (let ((ellipsis-width (string-length ellipsis)))
+
+    (define (print-sequence x width len ref next)
+      (let lp ((x x)
+               (width width)
+               (i 0))
+        (if (> i 0)
+            (display #\space))
+        (cond
+         ((= i len)) ; catches 0-length case
+         ((and (= i (1- len)) (or (zero? i) (> width 1)))
+          (print (ref x i) (if (zero? i) width (1- width))))
+         ((<= width (+ 1 ellipsis-width))
+          (display ellipsis))
+         (else
+          (let ((str (with-output-to-string
+                       (lambda ()
+                         (print (ref x i)
+                                (if breadth-first?
+                                    (max 1
+                                         (1- (floor (/ width (- len i)))))
+                                    (- width (+ 1 ellipsis-width))))))))
+            (display str)
+            (lp (next x) (- width 1 (string-length str)) (1+ i)))))))
+
+    (define (print-tree x width)
+      ;; width is >= the width of # . #, which is 5
+      (let lp ((x x)
+               (width width))
+        (cond
+         ((or (not (pair? x)) (<= width 4))
+          (display ". ")
+          (print x (- width 2)))
+         (else
+          ;; width >= 5
+          (let ((str (with-output-to-string
+                       (lambda ()
+                         (print (car x)
+                                (if breadth-first?
+                                    (floor (/ (- width 3) 2))
+                                    (- width 4)))))))
+            (display str)
+            (display " ")
+            (lp (cdr x) (- width 1 (string-length str))))))))
+
+    (define (truncate-string str width)
+      ;; width is < (string-length str)
+      (let lp ((fixes '(("#<" . ">")
+                        ("#(" . ")")
+                        ("(" . ")")
+                        ("\"" . "\""))))
+        (cond
+         ((null? fixes)
+          "#")
+         ((and (string-prefix? (caar fixes) str)
+               (string-suffix? (cdar fixes) str)
+               (>= (string-length str)
+                   width
+                   (+ (string-length (caar fixes))
+                      (string-length (cdar fixes))
+                      ellipsis-width)))
+          (format #f "~a~a~a~a"
+                  (caar fixes)
+                  (substring str (string-length (caar fixes))
+                             (- width (string-length (cdar fixes))
+                                ellipsis-width))
+                  ellipsis
+                  (cdar fixes)))
+         (else
+          (lp (cdr fixes))))))
+
+    (define (print x width)
+      (cond
+       ((<= width 0)
+        (error "expected a positive width" width))
+       ((list? x)
+        (cond
+         ((>= width (+ 2 ellipsis-width))
+          (display "(")
+          (print-sequence x (- width 2) (length x)
+                          (lambda (x i) (car x)) cdr)
+          (display ")"))
+         (else
+          (display "#"))))
+       ((vector? x)
+        (cond
+         ((>= width (+ 3 ellipsis-width))
+          (display "#(")
+          (print-sequence x (- width 3) (vector-length x)
+                          vector-ref identity)
+          (display ")"))
+         (else
+          (display "#"))))
+       ((uniform-vector? x)
+        (cond
+         ((>= width 9)
+          (format #t  "#~a(" (uniform-vector-element-type x))
+          (print-sequence x (- width 6) (uniform-vector-length x)
+                          uniform-vector-ref identity)
+          (display ")"))
+         (else
+          (display "#"))))
+       ((pair? x)
+        (cond
+         ((>= width (+ 4 ellipsis-width))
+          (display "(")
+          (print-tree x (- width 2))
+          (display ")"))
+         (else
+          (display "#"))))
+       (else
+        (let* ((str (with-output-to-string
+                      (lambda () (if display? (display x) (write x)))))
+               (len (string-length str)))
+          (display (if (<= (string-length str) width)
+                       str
+                       (truncate-string str width)))))))
+
+    (with-output-to-port port
+      (lambda ()
+        (print x width)))))
diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm
index 069574a49..2968dbd9f 100644
--- a/module/rnrs/io/ports.scm
+++ b/module/rnrs/io/ports.scm
@@ -303,8 +303,7 @@ read from/written to in @var{port}."
 
 (define (open-string-input-port str)
   "Open an input port that will read from @var{str}."
-  (with-fluids ((%default-port-encoding "UTF-8"))
-    (open-input-string str)))
+  (open-input-string str))
 
 (define (r6rs-open filename mode buffer-mode transcoder)
   (let ((port (with-i/o-filename-conditions filename
@@ -349,8 +348,7 @@ read from/written to in @var{port}."
 (define (open-string-output-port)
   "Return two values: an output port that will collect characters written to it
 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))))
+  (let ((port (open-output-string)))
     (values port
             (lambda () (get-output-string port)))))
 
diff --git a/module/srfi/srfi-6.scm b/module/srfi/srfi-6.scm
index 7b8bcb114..e6f8b438a 100644
--- a/module/srfi/srfi-6.scm
+++ b/module/srfi/srfi-6.scm
@@ -1,6 +1,7 @@
 ;;; srfi-6.scm --- Basic String Ports
 
-;; 	Copyright (C) 2001, 2002, 2003, 2006, 2012 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2002, 2003, 2006, 2012,
+;;   2013 Free Software Foundation, Inc.
 ;;
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -23,21 +24,6 @@
 ;;; Code:
 
 (define-module (srfi srfi-6)
-  #:replace (open-input-string open-output-string)
-  #:re-export (get-output-string))
-
-;; SRFI-6 says nothing about encodings, and assumes that any character
-;; or string can be written to a string port.  Thus, make all SRFI-6
-;; string ports Unicode capable.  See <http://bugs.gnu.org/11197>.
-
-(define (open-input-string s)
-  (with-fluids ((%default-port-encoding "UTF-8"))
-    ((@ (guile) open-input-string) s)))
-
-(define (open-output-string)
-  (with-fluids ((%default-port-encoding "UTF-8"))
-    ((@ (guile) open-output-string))))
-
-(cond-expand-provide (current-module) '(srfi-6))
+  #:re-export (open-input-string open-output-string get-output-string))
 
 ;;; srfi-6.scm ends here
diff --git a/test-suite/test-suite/lib.scm b/test-suite/test-suite/lib.scm
index e25df7891..740beb1ee 100644
--- a/test-suite/test-suite/lib.scm
+++ b/test-suite/test-suite/lib.scm
@@ -428,18 +428,15 @@
 
 ;;;; Turn a test name into a nice human-readable string.
 (define (format-test-name name)
-  ;; Choose a Unicode-capable encoding so that the string port can contain any
-  ;; valid Unicode character.
-  (with-fluids ((%default-port-encoding "UTF-8"))
-    (call-with-output-string
-     (lambda (port)
-       (let loop ((name name)
-                  (separator ""))
-         (if (pair? name)
-             (begin
-               (display separator port)
-               (display (car name) port)
-               (loop (cdr name) ": "))))))))
+  (call-with-output-string
+   (lambda (port)
+     (let loop ((name name)
+                (separator ""))
+       (if (pair? name)
+           (begin
+             (display separator port)
+             (display (car name) port)
+             (loop (cdr name) ": ")))))))
 
 ;;;; For a given test-name, deliver the full name including all prefixes.
 (define (full-name name)
diff --git a/test-suite/tests/chars.test b/test-suite/tests/chars.test
index 98854f73a..55cfead23 100644
--- a/test-suite/tests/chars.test
+++ b/test-suite/tests/chars.test
@@ -1,7 +1,7 @@
 ;;;; chars.test --- Characters.       -*- coding: utf-8; mode: scheme; -*-
 ;;;; Greg J. Badros <gjb@cs.washington.edu>
 ;;;;
-;;;; 	Copyright (C) 2000, 2006, 2009, 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2000, 2006, 2009, 2010, 2013 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -316,13 +316,11 @@
     (pass-if "combining accent is pretty-printed"
       (let ((accent (integer->char #x030f))) ; COMBINING DOUBLE GRAVE ACCENT
         (string=?
-         (with-fluids ((%default-port-encoding "UTF-8"))
-           (with-output-to-string (lambda () (write accent))))
+         (with-output-to-string (lambda () (write accent)))
          "#\\◌̏")))
 
     (pass-if "combining X is pretty-printed"
       (let ((x (integer->char #x0353))) ; COMBINING X BELOW
         (string=?
-         (with-fluids ((%default-port-encoding "UTF-8"))
-           (with-output-to-string (lambda () (write x))))
+         (with-output-to-string (lambda () (write x)))
          "#\\◌͓")))))
diff --git a/test-suite/tests/ecmascript.test b/test-suite/tests/ecmascript.test
index 17036f93d..96b1d6666 100644
--- a/test-suite/tests/ecmascript.test
+++ b/test-suite/tests/ecmascript.test
@@ -23,11 +23,9 @@
 
 
 (define (eread str)
-  (with-fluids ((%default-port-encoding "utf-8"))
-    (call-with-input-string str read-ecmascript)))
+  (call-with-input-string str read-ecmascript))
 (define (eread/1 str)
-  (with-fluids ((%default-port-encoding "utf-8"))
-    (call-with-input-string str read-ecmascript/1)))
+  (call-with-input-string str read-ecmascript/1))
 
 (define-syntax parse
   (syntax-rules ()
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 65c87da10..3d0bba588 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -698,32 +698,15 @@
     (pass-if "output check"
 	     (string=? text result)))
 
-  (pass-if "encoding failure leads to exception"
-    ;; Prior to 2.0.6, this would trigger a deadlock in `scm_mkstrport'.
-    ;; See the discussion at <http://bugs.gnu.org/11197>, for details.
-    (catch 'encoding-error
-      (lambda ()
-        (with-fluids ((%default-port-encoding "ISO-8859-1"))
-          (let ((p (open-input-string "λ")))      ; raise an exception
-            #f)))
-      (lambda (key . rest)
-        #t)
-      (lambda (key . rest)
-        ;; At this point, the port-table mutex used to be still held,
-        ;; hence the deadlock.  This situation would occur when trying
-        ;; to print a backtrace, for instance.
-        (input-port? (open-input-string "foo")))))
-
-  (pass-if "%default-port-encoding is honored"
-    (let ((encodings '("UTF-8" "UTF-16" "ISO-8859-1" "ISO-8859-3")))
-      (equal? (map (lambda (e)
-                     (with-fluids ((%default-port-encoding e))
-                       (call-with-output-string
-                         (lambda (p)
-                           (and (string=? e (port-encoding p))
-                                (display (port-encoding p) p))))))
-                   encodings)
-              encodings)))
+  (pass-if "%default-port-encoding is ignored"
+    (let ((str "ĉu bone?"))
+      ;; Latin-1 cannot represent ‘ĉ’.
+      (with-fluids ((%default-port-encoding "ISO-8859-1"))
+        (string=? (call-with-output-string
+                   (lambda (p)
+                     (set-port-conversion-strategy! p 'substitute)
+                     (display str p)))
+                  "ĉu bone?"))))
 
   (pass-if "%default-port-conversion-strategy is honored"
     (let ((strategies '(error substitute escape)))
@@ -740,77 +723,58 @@
               (map symbol->string strategies))))
 
   (pass-if "suitable encoding [latin-1]"
-    (let ((str "hello, world"))
-      (with-fluids ((%default-port-encoding "ISO-8859-1"))
-        (equal? str
-                (with-output-to-string
-                  (lambda ()
-                    (display str)))))))
+    (let ((str "hello, world")
+          (encoding "ISO-8859-1"))
+      (equal? str
+              (call-with-output-string
+               (lambda (p)
+                 (set-port-encoding! p encoding)
+                 (display str p))))))
 
   (pass-if "suitable encoding [latin-3]"
-    (let ((str "ĉu bone?"))
-      (with-fluids ((%default-port-encoding "ISO-8859-3"))
-        (equal? str
-                (with-output-to-string
-                  (lambda ()
-                    (display str)))))))
+    (let ((str "ĉu bone?")
+          (encoding "ISO-8859-3"))
+      (equal? str
+              (call-with-output-string
+               (lambda (p)
+                 (set-port-encoding! p encoding)
+                 (display str p))))))
 
   (pass-if "wrong encoding, error"
     (let ((str "ĉu bone?"))
       (catch 'encoding-error
         (lambda ()
-          ;; Latin-1 cannot represent ‘ĉ’.
-          (with-fluids ((%default-port-encoding "ISO-8859-1")
-                        (%default-port-conversion-strategy 'error))
-            (with-output-to-string
-              (lambda ()
-                (display str))))
-          #f)                            ; so the test really fails here
+          (with-fluids ((%default-port-conversion-strategy 'error))
+            (call-with-output-string
+             (lambda (p)
+               ;; Latin-1 cannot represent ‘ĉ’.
+               (set-port-encoding! p "ISO-8859-1")
+               (display str p))))
+          #f)                           ; so the test really fails here
         (lambda (key subr message errno port chr)
           (and (eqv? chr #\ĉ)
                (string? (strerror errno)))))))
 
   (pass-if "wrong encoding, substitute"
     (let ((str "ĉu bone?"))
-      (with-fluids ((%default-port-encoding "ISO-8859-1"))
-        (string=? (with-output-to-string
-                    (lambda ()
-                      (set-port-conversion-strategy! (current-output-port)
-                                                     'substitute)
-                      (display str)))
-                  "?u bone?"))))
+      (string=? (call-with-output-string
+                 (lambda (p)
+                   (set-port-encoding! p "ISO-8859-1")
+                   (set-port-conversion-strategy! p 'substitute)
+                   (display str p)))
+                "?u bone?")))
 
   (pass-if "wrong encoding, escape"
     (let ((str "ĉu bone?"))
-      (with-fluids ((%default-port-encoding "ISO-8859-1"))
-        (string=? (with-output-to-string
-                    (lambda ()
-                      (set-port-conversion-strategy! (current-output-port)
-                                                     'escape)
-                      (display str)))
-                  "\\u0109u bone?"))))
+      (string=? (call-with-output-string
+                 (lambda (p)
+                   (set-port-encoding! p "ISO-8859-1")
+                   (set-port-conversion-strategy! p 'escape)
+                   (display str p)))
+                "\\u0109u bone?")))
 
-  (pass-if "peek-char [latin-1]"
-    (let ((p (with-fluids ((%default-port-encoding #f))
-               (open-input-string "hello, world"))))
-      (and (char=? (peek-char p) #\h)
-           (char=? (peek-char p) #\h)
-           (char=? (peek-char p) #\h)
-           (= (port-line p) 0)
-           (= (port-column p) 0))))
-
-  (pass-if "peek-char [utf-8]"
-    (let ((p (with-fluids ((%default-port-encoding "UTF-8"))
-               (open-input-string "안녕하세요"))))
-      (and (char=? (peek-char p) #\안)
-           (char=? (peek-char p) #\안)
-           (char=? (peek-char p) #\안)
-           (= (port-line p) 0)
-           (= (port-column p) 0))))
-
-  (pass-if "peek-char [utf-16]"
-    (let ((p (with-fluids ((%default-port-encoding "UTF-16BE"))
-               (open-input-string "안녕하세요"))))
+  (pass-if "peek-char"
+    (let ((p (open-input-string "안녕하세요")))
       (and (char=? (peek-char p) #\안)
            (char=? (peek-char p) #\안)
            (char=? (peek-char p) #\안)
@@ -1207,10 +1171,15 @@
       (set-port-encoding! p "does-not-exist")
       (read p)))
 
-  (pass-if-exception "%default-port-encoding, wrong encoding"
-    exception:miscellaneous-error
-    (read (with-fluids ((%default-port-encoding "does-not-exist"))
-            (open-input-string "")))))
+  (let ((filename (test-file)))
+    (with-output-to-file filename (lambda () (write 'test)))
+
+    (pass-if-exception "%default-port-encoding, wrong encoding"
+        exception:miscellaneous-error
+      (read (with-fluids ((%default-port-encoding "does-not-exist"))
+              (open-input-file filename))))
+
+    (delete-file filename)))
 
 ;;;
 ;;; port-for-each
diff --git a/test-suite/tests/print.test b/test-suite/tests/print.test
index e60a40f7d..47a107736 100644
--- a/test-suite/tests/print.test
+++ b/test-suite/tests/print.test
@@ -1,6 +1,6 @@
 ;;;; -*- coding: utf-8; mode: scheme; -*-
 ;;;;
-;;;; Copyright (C) 2010  Free Software Foundation, Inc.
+;;;; Copyright (C) 2010, 2013  Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -59,31 +59,31 @@
   (define exp '(a b #(c d e) f . g))
 
   (define (tprint x width encoding)
-    (with-fluids ((%default-port-encoding encoding))
-      (with-output-to-string
-	(lambda ()
-	  (truncated-print x #:width width)))))
+    (call-with-output-string
+     (lambda (p)
+       (set-port-encoding! p encoding)
+       (truncated-print x p #:width width))))
 
-  (pass-if (equal? (tprint exp 10 "ISO-8859-1")
-		   "(a b . #)"))
+  (pass-if-equal "(a b . #)"
+      (tprint exp 10 "ISO-8859-1"))
 
-  (pass-if (equal? (tprint exp 15 "ISO-8859-1")
-		   "(a b # f . g)"))
+  (pass-if-equal "(a b # f . g)"
+      (tprint exp 15 "ISO-8859-1"))
 
-  (pass-if (equal? (tprint exp 18 "ISO-8859-1")
-		   "(a b #(c ...) . #)"))
+  (pass-if-equal "(a b #(c ...) . #)"
+      (tprint exp 18 "ISO-8859-1"))
 
-  (pass-if (equal? (tprint exp 20 "ISO-8859-1")
-		   "(a b #(c d e) f . g)"))
+  (pass-if-equal "(a b #(c d e) f . g)"
+      (tprint exp 20 "ISO-8859-1"))
 
-  (pass-if (equal? (tprint "The quick brown fox" 20 "ISO-8859-1")
-		   "\"The quick brown...\""))
+  (pass-if-equal "\"The quick brown...\""
+      (tprint "The quick brown fox" 20 "ISO-8859-1"))
 
-  (pass-if (equal? (tprint "The quick brown fox" 20 "UTF-8")
-		   "\"The quick brown f…\""))
+  (pass-if-equal "\"The quick brown f…\""
+      (tprint "The quick brown fox" 20 "UTF-8"))
 
-  (pass-if (equal? (tprint (current-module) 20 "ISO-8859-1")
-		   "#<directory (tes...>"))
+  (pass-if-equal "#<directory (tes...>"
+      (tprint (current-module) 20 "ISO-8859-1"))
 
-  (pass-if (equal? (tprint (current-module) 20 "UTF-8")
-		   "#<directory (test-…>")))
+  (pass-if-equal "#<directory (test-…>"
+      (tprint (current-module) 20 "UTF-8")))
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
index 4b756cce8..d0ae9d395 100644
--- a/test-suite/tests/r6rs-ports.test
+++ b/test-suite/tests/r6rs-ports.test
@@ -1,6 +1,6 @@
 ;;;; r6rs-ports.test --- R6RS I/O port tests.   -*- coding: utf-8; -*-
 ;;;;
-;;;; Copyright (C) 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
 ;;;; Ludovic Courtès
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
@@ -98,8 +98,7 @@
            (eof-object? (get-u8 port)))))
 
   (pass-if "lookahead-u8 non-ASCII"
-    (let ((port (with-fluids ((%default-port-encoding "UTF-8"))
-                  (open-input-string "λ"))))
+    (let ((port (open-input-string "λ")))
       (and (= 206 (lookahead-u8 port))
            (= 206 (lookahead-u8 port))
            (= 206 (get-u8 port))
@@ -272,21 +271,21 @@
     (let* ((str "hello, world")
            (bv  (string->utf16 str)))
       (equal? str
-              (with-fluids ((%default-port-encoding "UTF-16BE"))
-                (call-with-output-string
-                  (lambda (port)
-                    (put-bytevector port bv)))))))
+              (call-with-output-string
+               (lambda (port)
+                 (set-port-encoding! port "UTF-16BE")
+                 (put-bytevector port bv))))))
 
   (pass-if "put-bytevector with wrong-encoding string port"
     (let* ((str "hello, world")
            (bv  (string->utf16 str)))
       (catch 'decoding-error
         (lambda ()
-          (with-fluids ((%default-port-encoding "UTF-32")
-                        (%default-port-conversion-strategy 'error))
+          (with-fluids ((%default-port-conversion-strategy 'error))
             (call-with-output-string
-              (lambda (port)
-                (put-bytevector port bv)))
+             (lambda (port)
+               (set-port-encoding! port "UTF-32")
+               (put-bytevector port bv)))
             #f))                           ; fail if we reach this point
         (lambda (key subr message errno port)
           (string? (strerror errno)))))))
diff --git a/test-suite/tests/rdelim.test b/test-suite/tests/rdelim.test
index 5cfe6460d..437a0ee40 100644
--- a/test-suite/tests/rdelim.test
+++ b/test-suite/tests/rdelim.test
@@ -22,227 +22,225 @@
   #:use-module ((rnrs io ports) #:select (open-bytevector-input-port))
   #:use-module (test-suite lib))
 
-(with-fluids ((%default-port-encoding "UTF-8"))
+(with-test-prefix "read-line"
 
-  (with-test-prefix "read-line"
+  (pass-if "one line"
+    (let* ((s "hello, world")
+           (p (open-input-string s)))
+      (and (string=? s (read-line p))
+           (eof-object? (read-line p)))))
 
-    (pass-if "one line"
-      (let* ((s "hello, world")
-             (p (open-input-string s)))
-        (and (string=? s (read-line p))
-             (eof-object? (read-line p)))))
+  (pass-if "two lines, trim"
+    (let* ((s "foo\nbar\n")
+           (p (open-input-string s)))
+      (and (equal? (string-tokenize s)
+                   (list (read-line p) (read-line p)))
+           (eof-object? (read-line p)))))
 
-    (pass-if "two lines, trim"
-      (let* ((s "foo\nbar\n")
-             (p (open-input-string s)))
-        (and (equal? (string-tokenize s)
-                     (list (read-line p) (read-line p)))
-             (eof-object? (read-line p)))))
+  (pass-if "two lines, concat"
+    (let* ((s "foo\nbar\n")
+           (p (open-input-string s)))
+      (and (equal? '("foo\n" "bar\n")
+                   (list (read-line p 'concat)
+                         (read-line p 'concat)))
+           (eof-object? (read-line p)))))
 
-    (pass-if "two lines, concat"
-      (let* ((s "foo\nbar\n")
-             (p (open-input-string s)))
-        (and (equal? '("foo\n" "bar\n")
-                     (list (read-line p 'concat)
-                           (read-line p 'concat)))
-             (eof-object? (read-line p)))))
+  (pass-if "two lines, peek"
+    (let* ((s "foo\nbar\n")
+           (p (open-input-string s)))
+      (and (equal? '("foo" #\newline "bar" #\newline)
+                   (list (read-line p 'peek) (read-char p)
+                         (read-line p 'peek) (read-char p)))
+           (eof-object? (read-line p)))))
 
-    (pass-if "two lines, peek"
-      (let* ((s "foo\nbar\n")
-             (p (open-input-string s)))
-        (and (equal? '("foo" #\newline "bar" #\newline)
-                     (list (read-line p 'peek) (read-char p)
-                           (read-line p 'peek) (read-char p)))
-             (eof-object? (read-line p)))))
+  (pass-if "two lines, split"
+    (let* ((s "foo\nbar\n")
+           (p (open-input-string s)))
+      (and (equal? '(("foo" . #\newline)
+                     ("bar" . #\newline))
+                   (list (read-line p 'split)
+                         (read-line p 'split)))
+           (eof-object? (read-line p)))))
 
-    (pass-if "two lines, split"
-      (let* ((s "foo\nbar\n")
-             (p (open-input-string s)))
-        (and (equal? '(("foo" . #\newline)
-                       ("bar" . #\newline))
-                     (list (read-line p 'split)
-                           (read-line p 'split)))
-             (eof-object? (read-line p)))))
+  (pass-if "two Greek lines, trim"
+    (let* ((s "λαμβδα\nμυ\n")
+           (p (open-input-string s)))
+      (and (equal? (string-tokenize s)
+                   (list (read-line p) (read-line p)))
+           (eof-object? (read-line p)))))
 
-    (pass-if "two Greek lines, trim"
-      (let* ((s "λαμβδα\nμυ\n")
-             (p (open-input-string s)))
-        (and (equal? (string-tokenize s)
-                     (list (read-line p) (read-line p)))
-             (eof-object? (read-line p)))))
+  (pass-if "decoding error"
+    (let ((p (open-bytevector-input-port #vu8(65 255 66 67 68))))
+      (set-port-encoding! p "UTF-8")
+      (set-port-conversion-strategy! p 'error)
+      (catch 'decoding-error
+        (lambda ()
+          (read-line p)
+          #f)
+        (lambda (key subr message err port)
+          (and (eq? port p)
 
-    (pass-if "decoding error"
-      (let ((p (open-bytevector-input-port #vu8(65 255 66 67 68))))
-        (set-port-encoding! p "UTF-8")
-        (set-port-conversion-strategy! p 'error)
-        (catch 'decoding-error
-          (lambda ()
-            (read-line p)
-            #f)
-          (lambda (key subr message err port)
-            (and (eq? port p)
+               ;; PORT should now point past the error.
+               (string=? (read-line p) "BCD")
+               (eof-object? (read-line p)))))))
 
-                 ;; PORT should now point past the error.
-                 (string=? (read-line p) "BCD")
-                 (eof-object? (read-line p)))))))
-
-    (pass-if "decoding error, substitute"
-      (let ((p (open-bytevector-input-port #vu8(65 255 66 67 68))))
-        (set-port-encoding! p "UTF-8")
-        (set-port-conversion-strategy! p 'substitute)
-        (and (string=? (read-line p) "A?BCD")
-             (eof-object? (read-line p))))))
+  (pass-if "decoding error, substitute"
+    (let ((p (open-bytevector-input-port #vu8(65 255 66 67 68))))
+      (set-port-encoding! p "UTF-8")
+      (set-port-conversion-strategy! p 'substitute)
+      (and (string=? (read-line p) "A?BCD")
+           (eof-object? (read-line p))))))
 
 
-  (with-test-prefix "read-delimited"
+(with-test-prefix "read-delimited"
 
-    (pass-if "delimiter hit"
-      (let ((p (open-input-string "hello, world!")))
-        (and (string=? "hello" (read-delimited ",.;" p))
-             (string=? " world!" (read-delimited ",.;" p))
-             (eof-object? (read-delimited ",.;" p)))))
+  (pass-if "delimiter hit"
+    (let ((p (open-input-string "hello, world!")))
+      (and (string=? "hello" (read-delimited ",.;" p))
+           (string=? " world!" (read-delimited ",.;" p))
+           (eof-object? (read-delimited ",.;" p)))))
 
-    (pass-if "delimiter hit, split"
-      (equal? '("hello" . #\,)
-              (read-delimited ",.;"
-                              (open-input-string "hello, world!")
-                              'split)))
+  (pass-if "delimiter hit, split"
+    (equal? '("hello" . #\,)
+            (read-delimited ",.;"
+                            (open-input-string "hello, world!")
+                            'split)))
 
-    (pass-if "delimiter hit, concat"
-      (equal? '"hello,"
-              (read-delimited ",.;" (open-input-string "hello, world!")
-                              'concat)))
+  (pass-if "delimiter hit, concat"
+    (equal? '"hello,"
+            (read-delimited ",.;" (open-input-string "hello, world!")
+                            'concat)))
 
-    (pass-if "delimiter hit, peek"
-      (let ((p (open-input-string "hello, world!")))
-        (and (string=? "hello" (read-delimited ",.;" p 'peek))
-             (char=? #\, (peek-char p)))))
+  (pass-if "delimiter hit, peek"
+    (let ((p (open-input-string "hello, world!")))
+      (and (string=? "hello" (read-delimited ",.;" p 'peek))
+           (char=? #\, (peek-char p)))))
 
-    (pass-if "eof"
-      (eof-object? (read-delimited "}{" (open-input-string "")))))
+  (pass-if "eof"
+    (eof-object? (read-delimited "}{" (open-input-string "")))))
 
 
-  (with-test-prefix "read-delimited!"
+(with-test-prefix "read-delimited!"
 
-    (pass-if "delimiter hit"
-      (let ((s (make-string 123))
-            (p (open-input-string "hello, world!")))
-        (and (= 5 (read-delimited! ",.;" s p))
-             (string=? (substring s 0 5) "hello")
-             (= 7 (read-delimited! ",.;" s p))
-             (string=? (substring s 0 7) " world!")
-             (eof-object? (read-delimited! ",.;" s p)))))
+  (pass-if "delimiter hit"
+    (let ((s (make-string 123))
+          (p (open-input-string "hello, world!")))
+      (and (= 5 (read-delimited! ",.;" s p))
+           (string=? (substring s 0 5) "hello")
+           (= 7 (read-delimited! ",.;" s p))
+           (string=? (substring s 0 7) " world!")
+           (eof-object? (read-delimited! ",.;" s p)))))
 
-    (pass-if "delimiter hit, start+end"
-      (let ((s (make-string 123))
-            (p (open-input-string "hello, world!")))
-        (and (= 5 (read-delimited! ",.;" s p 'trim 10 30))
-             (string=? (substring s 10 15) "hello"))))
+  (pass-if "delimiter hit, start+end"
+    (let ((s (make-string 123))
+          (p (open-input-string "hello, world!")))
+      (and (= 5 (read-delimited! ",.;" s p 'trim 10 30))
+           (string=? (substring s 10 15) "hello"))))
 
-    (pass-if "delimiter hit, split"
-      (let ((s (make-string 123)))
-        (and (equal? '(5 . #\,)
-                     (read-delimited! ",.;" s
-                                      (open-input-string "hello, world!")
-                                      'split))
-             (string=? (substring s 0 5) "hello"))))
+  (pass-if "delimiter hit, split"
+    (let ((s (make-string 123)))
+      (and (equal? '(5 . #\,)
+                   (read-delimited! ",.;" s
+                                    (open-input-string "hello, world!")
+                                    'split))
+           (string=? (substring s 0 5) "hello"))))
 
-    (pass-if "delimiter hit, concat"
-      (let ((s (make-string 123)))
-        (and (= 6 (read-delimited! ",.;" s
-                                   (open-input-string "hello, world!")
-                                   'concat))
-             (string=? (substring s 0 6) "hello,"))))
+  (pass-if "delimiter hit, concat"
+    (let ((s (make-string 123)))
+      (and (= 6 (read-delimited! ",.;" s
+                                 (open-input-string "hello, world!")
+                                 'concat))
+           (string=? (substring s 0 6) "hello,"))))
 
-    (pass-if "delimiter hit, peek"
-      (let ((s (make-string 123))
-            (p (open-input-string "hello, world!")))
-        (and (= 5 (read-delimited! ",.;" s p 'peek))
-             (string=? (substring s 0 5) "hello")
-             (char=? #\, (peek-char p)))))
+  (pass-if "delimiter hit, peek"
+    (let ((s (make-string 123))
+          (p (open-input-string "hello, world!")))
+      (and (= 5 (read-delimited! ",.;" s p 'peek))
+           (string=? (substring s 0 5) "hello")
+           (char=? #\, (peek-char p)))))
 
-    (pass-if "string too small"
-      (let ((s (make-string 7)))
-        (and (= 7 (read-delimited! "}{" s
-                                   (open-input-string "hello, world!")))
-             (string=? s "hello, "))))
+  (pass-if "string too small"
+    (let ((s (make-string 7)))
+      (and (= 7 (read-delimited! "}{" s
+                                 (open-input-string "hello, world!")))
+           (string=? s "hello, "))))
 
-    (pass-if "string too small, start+end"
-      (let ((s (make-string 123)))
-        (and (= 7 (read-delimited! "}{" s
-                                   (open-input-string "hello, world!")
-                                   'trim
-                                   70 77))
-             (string=? (substring s 70 77) "hello, "))))
+  (pass-if "string too small, start+end"
+    (let ((s (make-string 123)))
+      (and (= 7 (read-delimited! "}{" s
+                                 (open-input-string "hello, world!")
+                                 'trim
+                                 70 77))
+           (string=? (substring s 70 77) "hello, "))))
 
-    (pass-if "string too small, split"
-      (let ((s (make-string 7)))
-        (and (equal? '(7 . #f)
-                     (read-delimited! "}{" s
-                                      (open-input-string "hello, world!")
-                                      'split))
-             (string=? s "hello, "))))
+  (pass-if "string too small, split"
+    (let ((s (make-string 7)))
+      (and (equal? '(7 . #f)
+                   (read-delimited! "}{" s
+                                    (open-input-string "hello, world!")
+                                    'split))
+           (string=? s "hello, "))))
 
-    (pass-if "eof"
-      (eof-object? (read-delimited! ":" (make-string 7)
-                                    (open-input-string ""))))
+  (pass-if "eof"
+    (eof-object? (read-delimited! ":" (make-string 7)
+                                  (open-input-string ""))))
 
-    (pass-if "eof, split"
-      (eof-object? (read-delimited! ":" (make-string 7)
-                                    (open-input-string "")))))
+  (pass-if "eof, split"
+    (eof-object? (read-delimited! ":" (make-string 7)
+                                  (open-input-string "")))))
 
-  (with-test-prefix "read-string"
+(with-test-prefix "read-string"
 
-    (pass-if "short string"
-      (let* ((s "hello, world!")
-             (p (open-input-string s)))
-        (and (string=? (read-string p) s)
-             (string=? (read-string p) ""))))
+  (pass-if "short string"
+    (let* ((s "hello, world!")
+           (p (open-input-string s)))
+      (and (string=? (read-string p) s)
+           (string=? (read-string p) ""))))
 
-    (pass-if "100 chars"
-      (let* ((s (make-string 100 #\space))
-             (p (open-input-string s)))
-        (and (string=? (read-string p) s)
-             (string=? (read-string p) ""))))
+  (pass-if "100 chars"
+    (let* ((s (make-string 100 #\space))
+           (p (open-input-string s)))
+      (and (string=? (read-string p) s)
+           (string=? (read-string p) ""))))
 
-    (pass-if "longer than 100 chars"
-      (let* ((s (string-concatenate (make-list 20 "hello, world!")))
-             (p (open-input-string s)))
-        (and (string=? (read-string p) s)
-             (string=? (read-string p) "")))))
+  (pass-if "longer than 100 chars"
+    (let* ((s (string-concatenate (make-list 20 "hello, world!")))
+           (p (open-input-string s)))
+      (and (string=? (read-string p) s)
+           (string=? (read-string p) "")))))
 
-  (with-test-prefix "read-string!"
+(with-test-prefix "read-string!"
 
-    (pass-if "buf smaller"
-      (let* ((s "hello, world!")
-             (len (1- (string-length s)))
-             (buf (make-string len #\.))
-             (p (open-input-string s)))
-        (and (= (read-string! buf p) len)
-             (string=? buf (substring s 0 len))
-             (= (read-string! buf p) 1)
-             (string=? (substring buf 0 1) (substring s len)))))
+  (pass-if "buf smaller"
+    (let* ((s "hello, world!")
+           (len (1- (string-length s)))
+           (buf (make-string len #\.))
+           (p (open-input-string s)))
+      (and (= (read-string! buf p) len)
+           (string=? buf (substring s 0 len))
+           (= (read-string! buf p) 1)
+           (string=? (substring buf 0 1) (substring s len)))))
 
-    (pass-if "buf right size"
-      (let* ((s "hello, world!")
-             (len (string-length s))
-             (buf (make-string len #\.))
-             (p (open-input-string s)))
-        (and (= (read-string! buf p) len)
-             (string=? buf (substring s 0 len))
-             (= (read-string! buf p) 0)
-             (string=? buf (substring s 0 len)))))
+  (pass-if "buf right size"
+    (let* ((s "hello, world!")
+           (len (string-length s))
+           (buf (make-string len #\.))
+           (p (open-input-string s)))
+      (and (= (read-string! buf p) len)
+           (string=? buf (substring s 0 len))
+           (= (read-string! buf p) 0)
+           (string=? buf (substring s 0 len)))))
 
-    (pass-if "buf bigger"
-      (let* ((s "hello, world!")
-             (len (string-length s))
-             (buf (make-string (1+ len) #\.))
-             (p (open-input-string s)))
-        (and (= (read-string! buf p) len)
-             (string=? (substring buf 0 len) s)
-             (= (read-string! buf p) 0)
-             (string=? (substring buf 0 len) s)
-             (string=? (substring buf len) "."))))))
+  (pass-if "buf bigger"
+    (let* ((s "hello, world!")
+           (len (string-length s))
+           (buf (make-string (1+ len) #\.))
+           (p (open-input-string s)))
+      (and (= (read-string! buf p) len)
+           (string=? (substring buf 0 len) s)
+           (= (read-string! buf p) 0)
+           (string=? (substring buf 0 len) s)
+           (string=? (substring buf len) ".")))))
 
 ;;; Local Variables:
 ;;; eval: (put 'with-test-prefix 'scheme-indent-function 1)
diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test
index 6e02255ad..e1fe22dad 100644
--- a/test-suite/tests/reader.test
+++ b/test-suite/tests/reader.test
@@ -1,6 +1,7 @@
 ;;;; reader.test --- Reader test.    -*- coding: iso-8859-1; mode: scheme -*-
 ;;;;
-;;;; Copyright (C) 1999, 2001, 2002, 2003, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2001, 2002, 2003, 2007, 2008, 2009, 2010, 2011,
+;;;;   2013 Free Software Foundation, Inc.
 ;;;; Jim Blandy <jimb@red-bean.com>
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
@@ -47,8 +48,7 @@
 
 
 (define (read-string s)
-  (with-fluids ((%default-port-encoding #f))
-    (with-input-from-string s (lambda () (read)))))
+  (with-input-from-string s (lambda () (read))))
 
 (define (with-read-options opts thunk)
   (let ((saved-options (read-options)))
diff --git a/test-suite/tests/regexp.test b/test-suite/tests/regexp.test
index 6799423fc..d25a3d42d 100644
--- a/test-suite/tests/regexp.test
+++ b/test-suite/tests/regexp.test
@@ -155,14 +155,6 @@
 
 (define char-code-limit 256)
 
-;; Since `regexp-quote' uses string ports, and since it is used below
-;; with non-ASCII characters, these ports must be Unicode-capable.
-(define-syntax with-unicode
-  (syntax-rules ()
-    ((_ exp)
-     (with-fluids ((%default-port-encoding "UTF-8"))
-       exp))))
-
 (with-test-prefix "regexp-quote"
 
   (pass-if-exception "no args" exception:wrong-num-args
@@ -191,7 +183,7 @@
                     (s (string c)))
                (pass-if (list "char" i (format #f "~s ~s" c s))
                  (with-ascii-or-latin1-locale i
-                  (let* ((q (with-unicode (regexp-quote s)))
+                  (let* ((q (regexp-quote s))
                          (m (regexp-exec (make-regexp q flag) s)))
                     (and (= 0 (match:start m))
                          (= 1 (match:end m))))))))
@@ -204,7 +196,7 @@
 	       ((>= i 256))
              (let* ((c (integer->char i))
                     (s (string #\a c))
-                    (q (with-unicode (regexp-quote s))))
+                    (q (regexp-quote s)))
                (pass-if (list "string \"aX\"" i (format #f "~s ~s ~s" c s q))
                  (with-ascii-or-latin1-locale i
 		  (let* ((m (regexp-exec (make-regexp q flag) s)))
@@ -213,9 +205,9 @@
 
 	   (pass-if "string of all chars"
              (with-latin1-locale
-               (let ((m (regexp-exec (make-regexp (with-unicode
-                                                   (regexp-quote allchars))
-                                                  flag) allchars)))
+               (let ((m (regexp-exec (make-regexp (regexp-quote allchars)
+                                                  flag)
+                                     allchars)))
                  (and (= 0 (match:start m))
                       (= (string-length allchars) (match:end m)))))))))
      lst)))
diff --git a/test-suite/tests/srfi-105.test b/test-suite/tests/srfi-105.test
index 99a084bb3..d212bd084 100644
--- a/test-suite/tests/srfi-105.test
+++ b/test-suite/tests/srfi-105.test
@@ -1,6 +1,6 @@
 ;;;; srfi-105.test --- Test suite for Guile's SRFI-105 reader. -*- scheme -*-
 ;;;;
-;;;; Copyright (C) 2012 Free Software Foundation, Inc.
+;;;; Copyright (C) 2012, 2013 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -21,8 +21,7 @@
   #:use-module (srfi srfi-1))
 
 (define (read-string s)
-  (with-fluids ((%default-port-encoding #f))
-    (with-input-from-string s read)))
+  (with-input-from-string s read))
 
 (define (with-read-options opts thunk)
   (let ((saved-options (read-options)))