mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 01:00:20 +02:00
Code Activity

Improve encoding error reporting.

Browse source 
* libguile/strings.c (scm_encoding_error): Change arguments to convey
  more information.  Raise the error with `scm_throw ()', passing all
  the information to the handler.
  (scm_from_stringn, scm_to_stringn): Update accordingly.

* test-suite/tests/ports.test ("string ports")["wrong encoding"]: Check
  the arguments passed to the `throw' handler.

* test-suite/tests/r6rs-ports.test ("7.2.11 Binary
  Output")["put-bytevector with wrong-encoding string port"]: Likewise.
This commit is contained in:
Ludovic Courtès 2010-03-18 20:23:12 +01:00
parent f4c79b3c08
commit ef7e4ba373
3 changed files with 57 additions and 35 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -335,14 +335,20 @@
(lambda ()
(display str)))))))
(pass-if-exception "wrong encoding"
exception:encoding-error
(pass-if "wrong encoding"
(let ((str "ĉu bone?"))
;; Latin-1 cannot represent ‘ĉ’.
(with-fluids ((%default-port-encoding "ISO-8859-1"))
(with-output-to-string
(lambda ()
(display str)))))))
(catch 'encoding-error
(lambda ()
;; Latin-1 cannot represent ‘ĉ’.
(with-fluids ((%default-port-encoding "ISO-8859-1"))
(with-output-to-string
(lambda ()
(display str)))))
(lambda (key subr message errno from to faulty-str)
(and (eq? faulty-str str)
(string=? from "UTF-32")
(string=? to "ISO-8859-1")
(string? (strerror errno))))))))
(with-test-prefix "call-with-output-string"

17
test-suite/tests/r6rs-ports.test
View file

@ -230,14 +230,19 @@
(lambda (port)
(put-bytevector port bv)))))))
(pass-if-exception "put-bytevector with wrong-encoding string port"
exception:encoding-error
(pass-if "put-bytevector with wrong-encoding string port"
(let* ((str "hello, world")
(bv (string->utf16 str)))
(with-fluids ((%default-port-encoding "UTF-32"))
(call-with-output-string
(lambda (port)
(put-bytevector port bv)))))))
(catch 'encoding-error
(lambda ()
(with-fluids ((%default-port-encoding "UTF-32"))
(call-with-output-string
(lambda (port)
(put-bytevector port bv)))))
(lambda (key subr message errno from to faulty-bv)
(and (bytevector=? faulty-bv bv)
(string=? to "UTF-32")
(string? (strerror errno))))))))
(with-test-prefix "7.2.7 Input Ports"