summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/ports.c12
-rw-r--r--libguile/print.c10
-rw-r--r--libguile/strings.c24
-rw-r--r--libguile/strings.h4
-rw-r--r--test-suite/tests/encoding-escapes.test52
-rw-r--r--test-suite/tests/ports.test6
6 files changed, 60 insertions, 48 deletions
diff --git a/libguile/ports.c b/libguile/ports.c
index 46404bec1..270071cf4 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -1571,15 +1571,9 @@ scm_ungetc (scm_t_wchar c, SCM port)
result_buf, &len);
if (SCM_UNLIKELY (result == NULL || len == 0))
- {
- SCM chr;
-
- chr = scm_integer_to_char (scm_from_uint32 (c));
- scm_encoding_error (FUNC_NAME, errno,
- "conversion to port encoding failed",
- "UTF-32", encoding,
- scm_string (scm_list_1 (chr)));
- }
+ scm_encoding_error (FUNC_NAME, errno,
+ "conversion to port encoding failed",
+ SCM_BOOL_F, SCM_MAKE_CHAR (c));
for (i = len - 1; i >= 0; i--)
scm_unget_byte (result[i], port);
diff --git a/libguile/print.c b/libguile/print.c
index 9e48589f4..59b109380 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -484,8 +484,7 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
scm_i_get_conversion_strategy (port)))
scm_encoding_error (__func__, errno,
"cannot convert to output locale",
- "UTF-32", scm_i_get_port_encoding (port),
- scm_string (scm_list_1 (exp)));
+ port, exp);
}
}
else if (SCM_IFLAGP (exp)
@@ -570,11 +569,9 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
len, port,
scm_i_get_conversion_strategy (port));
if (SCM_UNLIKELY (printed < len))
- /* FIXME: Provide the error location. */
scm_encoding_error (__func__, errno,
"cannot convert to output locale",
- "UTF-32", scm_i_get_port_encoding (port),
- exp);
+ port, scm_c_string_ref (exp, printed));
}
scm_remember_upto_here_1 (exp);
@@ -1388,8 +1385,7 @@ SCM_DEFINE (scm_write_char, "write-char", 1, 1, 0,
scm_i_get_conversion_strategy (port)))
scm_encoding_error (__func__, errno,
"cannot convert to output locale",
- "UTF-32", scm_i_get_port_encoding (port),
- scm_string (scm_list_1 (chr)));
+ port, chr);
return SCM_UNSPECIFIED;
}
diff --git a/libguile/strings.c b/libguile/strings.c
index 7a580609e..b13cb780f 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -1412,21 +1412,17 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1,
SCM_SYMBOL (scm_encoding_error_key, "encoding-error");
SCM_SYMBOL (scm_decoding_error_key, "decoding-error");
+/* Raise an exception informing that character CHR could not be written
+ to PORT in its current encoding. */
void
scm_encoding_error (const char *subr, int err, const char *message,
- const char *from, const char *to, SCM string_or_bv)
+ SCM port, SCM chr)
{
- /* Raise an exception that conveys all the information needed to debug the
- problem. Only perform locale conversions that are safe; in particular,
- don't try to display STRING_OR_BV when it's a string since converting it to
- the output locale may fail. */
scm_throw (scm_encoding_error_key,
scm_list_n (scm_from_locale_string (subr),
scm_from_locale_string (message),
scm_from_int (err),
- scm_from_locale_string (from),
- scm_from_locale_string (to),
- string_or_bv,
+ port, chr,
SCM_UNDEFINED));
}
@@ -1938,8 +1934,10 @@ scm_to_stringn (SCM str, size_t *lenp, const char *encoding,
if (ret != 0)
scm_encoding_error (__func__, errno,
- "cannot convert to output locale",
- "ISO-8859-1", enc, str);
+ "cannot convert narrow string to output locale",
+ SCM_BOOL_F,
+ /* FIXME: Faulty character unknown. */
+ SCM_BOOL_F);
}
else
{
@@ -1951,8 +1949,10 @@ scm_to_stringn (SCM str, size_t *lenp, const char *encoding,
NULL, &len);
if (buf == NULL)
scm_encoding_error (__func__, errno,
- "cannot convert to output locale",
- "UTF-32", enc, str);
+ "cannot convert wide string to output locale",
+ SCM_BOOL_F,
+ /* FIXME: Faulty character unknown. */
+ SCM_BOOL_F);
}
if (handler == SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE)
{
diff --git a/libguile/strings.h b/libguile/strings.h
index 329e6c185..ed3a067c2 100644
--- a/libguile/strings.h
+++ b/libguile/strings.h
@@ -211,9 +211,7 @@ SCM_INTERNAL int scm_i_try_narrow_string (SCM str);
SCM_INTERNAL SCM scm_i_symbol_substring (SCM sym, size_t start, size_t end);
SCM_INTERNAL scm_t_wchar scm_i_symbol_ref (SCM sym, size_t x);
SCM_INTERNAL void scm_encoding_error (const char *subr, int err,
- const char *message,
- const char *from, const char *to,
- SCM string_or_bv);
+ const char *message, SCM port, SCM chr);
SCM_INTERNAL void scm_decoding_error (const char *subr, int err,
const char *message, SCM port);
diff --git a/test-suite/tests/encoding-escapes.test b/test-suite/tests/encoding-escapes.test
index ee3fba1b1..bfffcd2e2 100644
--- a/test-suite/tests/encoding-escapes.test
+++ b/test-suite/tests/encoding-escapes.test
@@ -67,19 +67,45 @@
(with-test-prefix "display output errors"
- (pass-if-exception "ultima"
- exception:encoding-error
- (let ((pt (open-output-string)))
- (set-port-encoding! pt "ASCII")
- (set-port-conversion-strategy! pt 'error)
- (display s1 pt)))
-
- (pass-if-exception "Rashomon"
- exception:encoding-error
- (let ((pt (open-output-string)))
- (set-port-encoding! pt "ASCII")
- (set-port-conversion-strategy! pt 'error)
- (display s4 pt))))
+ (pass-if "ultima"
+ (let ((pt (open-output-string)))
+ (set-port-encoding! pt "ASCII")
+ (set-port-conversion-strategy! pt 'error)
+ (catch 'encoding-error
+ (lambda ()
+ (display s1 pt)
+ #f)
+ (lambda (key subr message errno port chr)
+ (and (eq? port pt)
+ (char=? chr (string-ref s1 0))
+ (string=? (get-output-string pt) ""))))))
+
+ (pass-if "Rashomon"
+ (let ((pt (open-output-string)))
+ (set-port-encoding! pt "ASCII")
+ (set-port-conversion-strategy! pt 'error)
+ (catch 'encoding-error
+ (lambda ()
+ (display s4 pt)
+ #f)
+ (lambda (key subr message errno port chr)
+ (and (eq? port pt)
+ (char=? chr (string-ref s4 0))
+ (string=? (get-output-string pt) ""))))))
+
+ (pass-if "tekniko"
+ (let ((pt (open-output-string)))
+ (set-port-encoding! pt "ASCII")
+ (set-port-conversion-strategy! pt 'error)
+ (catch 'encoding-error
+ (lambda ()
+ ;; This time encoding should fail on the 3rd character.
+ (display "teĥniko" pt)
+ #f)
+ (lambda (key subr message errno port chr)
+ (and (eq? port pt)
+ (char=? chr #\ĥ)
+ (string=? "te" (get-output-string pt))))))))
;; Check that questions marks or substitutions appear when the conversion
;; mode is substitute
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index a794b94d5..3104ca178 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -420,10 +420,8 @@
(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")
+ (lambda (key subr message errno port chr)
+ (and (eq? chr #\ĉ)
(string? (strerror errno)))))))
(pass-if "wrong encoding, substitute"