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) if ((modes & SCM_WRTNG) && pt->write_pos == pt->write_end)
st_flush (z); st_flush (z);
pt->ilseq_handler = SCM_FAILED_CONVERSION_ERROR;
return z; 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 "…")) (let ((e "…"))
(catch 'encoding-error (catch 'encoding-error
(lambda () (lambda ()
(with-output-to-string (with-fluids ((%default-port-conversion-strategy 'error))
(lambda () (with-output-to-string
(display e)))) (lambda ()
(display e)))))
(lambda (key . args) (lambda (key . args)
"...")))) "..."))))

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

@ -424,6 +424,20 @@
encodings) encodings)
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]" (pass-if "suitable encoding [latin-1]"
(let ((str "hello, world")) (let ((str "hello, world"))
(with-fluids ((%default-port-encoding "ISO-8859-1")) (with-fluids ((%default-port-encoding "ISO-8859-1"))
@ -440,15 +454,17 @@
(lambda () (lambda ()
(display str))))))) (display str)))))))
(pass-if "wrong encoding" (pass-if "wrong encoding, error"
(let ((str "ĉu bone?")) (let ((str "ĉu bone?"))
(catch 'encoding-error (catch 'encoding-error
(lambda () (lambda ()
;; Latin-1 cannot represent ‘ĉ’. ;; 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 (with-output-to-string
(lambda () (lambda ()
(display str))))) (display str))))
#f) ; so the test really fails here
(lambda (key subr message errno port chr) (lambda (key subr message errno port chr)
(and (eq? chr #\ĉ) (and (eq? chr #\ĉ)
(string? (strerror errno))))))) (string? (strerror errno)))))))