Have string ports honor `%default-port-conversion-strategy'.

* libguile/strports.c (scm_mkstrport): Remove initialization of
  `pt->ilseq_handler'.

* module/ice-9/pretty-print.scm (truncated-print)[ellipsis]: Set
  %DEFAULT-PORT-CONVERSION-STRATEGY to 'error.

* test-suite/tests/ports.test ("string
  ports")["%default-port-conversion-strategy is honored"]: New test.
  ["wrong encoding"]: Rename to...
  ["wrong encoding, error"]: ... this.  Explicitly set
  %DEFAULT-PORT-CONVERSION-STRATEGY to 'error.  Return #f when no
  exception is raised.

diff --git a/libguile/strports.c b/libguile/strports.c
index 649c247..ca3a2cf 100644 (file)
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -337,7 +337,6 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
   if ((modes & SCM_WRTNG) && pt->write_pos == pt->write_end)
     st_flush (z);
 
-  pt->ilseq_handler = SCM_FAILED_CONVERSION_ERROR;
   return z;
 }
 

diff --git a/module/ice-9/pretty-print.scm b/module/ice-9/pretty-print.scm
index bf45eed..5c23cb0 100644 (file)
--- a/module/ice-9/pretty-print.scm
+++ b/module/ice-9/pretty-print.scm
@@ -320,9 +320,10 @@ sub-expression, via the @var{breadth-first?} keyword argument."
       (let ((e "…"))
         (catch 'encoding-error
           (lambda ()
-            (with-output-to-string
-              (lambda ()
-                (display e))))
+            (with-fluids ((%default-port-conversion-strategy 'error))
+              (with-output-to-string
+                (lambda ()
+                  (display e)))))
           (lambda (key . args)
             "..."))))
 

diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 2b161b5..7728e25 100644 (file)
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -424,6 +424,20 @@
                    encodings)
               encodings)))
 
+  (pass-if "%default-port-conversion-strategy is honored"
+    (let ((strategies '(error substitute escape)))
+      (equal? (map (lambda (s)
+                     (with-fluids ((%default-port-conversion-strategy s))
+                       (call-with-output-string
+                        (lambda (p)
+                          (and (eq? s (port-conversion-strategy p))
+                               (begin
+                                 (set-port-conversion-strategy! p s)
+                                 (display (port-conversion-strategy p)
+                                          p)))))))
+                   strategies)
+              (map symbol->string strategies))))
+
   (pass-if "suitable encoding [latin-1]"
     (let ((str "hello, world"))
       (with-fluids ((%default-port-encoding "ISO-8859-1"))
@@ -440,15 +454,17 @@
                   (lambda ()
                     (display str)))))))
 
-  (pass-if "wrong encoding"
+  (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"))
+          (with-fluids ((%default-port-encoding "ISO-8859-1")
+                        (%default-port-conversion-strategy 'error))
             (with-output-to-string
               (lambda ()
-                (display str)))))
+                (display str))))
+          #f)                            ; so the test really fails here
         (lambda (key subr message errno port chr)
           (and (eq? chr #\ĉ)
                (string? (strerror errno)))))))