mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

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

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2012-05-29 23:39:05 +02:00
parent b22e94db7c
commit 9f6e3f5a99
3 changed files with 23 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

1
libguile/strports.c
View file

@ -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;
}

7
module/ice-9/pretty-print.scm
View file

@ -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)
"..."))))

22
test-suite/tests/ports.test
View file

@ -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)))))))