diff options
-rw-r--r-- | libguile/ports.c | 12 | ||||
-rw-r--r-- | libguile/print.c | 10 | ||||
-rw-r--r-- | libguile/strings.c | 24 | ||||
-rw-r--r-- | libguile/strings.h | 4 | ||||
-rw-r--r-- | test-suite/tests/encoding-escapes.test | 52 | ||||
-rw-r--r-- | test-suite/tests/ports.test | 6 |
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" |