diff --git a/libguile/strings.c b/libguile/strings.c index d977655a2..4ae07a2dd 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -35,6 +35,7 @@ #include "libguile/chars.h" #include "libguile/root.h" #include "libguile/strings.h" +#include "libguile/error.h" #include "libguile/generalized-vectors.h" #include "libguile/deprecation.h" #include "libguile/validate.h" @@ -1386,6 +1387,16 @@ scm_is_string (SCM obj) return IS_STRING (obj); } + +/* Conversion to/from other encodings. */ + +SCM_SYMBOL (scm_encoding_error_key, "encoding-error"); +static void +scm_encoding_error (const char *subr, const char *message, SCM args) +{ + scm_error (scm_encoding_error_key, subr, message, args, SCM_BOOL_F); +} + SCM scm_from_stringn (const char *str, size_t len, const char *encoding, scm_t_string_failed_conversion_handler handler) @@ -1426,9 +1437,10 @@ scm_from_stringn (const char *str, size_t len, const char *encoding, char *dst; errstr = scm_i_make_string (len, &dst); memcpy (dst, str, len); - scm_misc_error (NULL, "input locale conversion error from ~s: ~s", - scm_list_2 (scm_from_locale_string (encoding), - errstr)); + scm_encoding_error (NULL, + "input locale conversion error from ~s: ~s", + scm_list_2 (scm_from_locale_string (encoding), + errstr)); scm_remember_upto_here_1 (errstr); } } @@ -1675,11 +1687,8 @@ scm_to_stringn (SCM str, size_t *lenp, const char *encoding, unistring_escapes_to_guile_escapes (&buf, &len); if (ret != 0) - { - scm_misc_error (NULL, "cannot convert to output locale ~s: \"~s\"", - scm_list_2 (scm_from_locale_string (enc), - str)); - } + scm_encoding_error (NULL, "cannot convert to output locale ~s: \"~s\"", + scm_list_2 (scm_from_locale_string (enc), str)); } else { @@ -1690,11 +1699,9 @@ scm_to_stringn (SCM str, size_t *lenp, const char *encoding, NULL, NULL, &len); if (buf == NULL) - { - scm_misc_error (NULL, "cannot convert to output locale ~s: \"~s\"", - scm_list_2 (scm_from_locale_string (enc), - str)); - } + scm_encoding_error (NULL, "cannot convert to output locale ~s: \"~s\"", + scm_list_2 (scm_from_locale_string (enc), str)); + if (handler == SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE) unistring_escapes_to_guile_escapes (&buf, &len); } @@ -1740,6 +1747,9 @@ scm_to_locale_stringbuf (SCM str, char *buf, size_t max_len) return len; } + +/* Unicode string normalization. */ + /* This function is a partial clone of SCM_STRING_TO_U32_BUF from libguile/i18n.c. It would be useful to have this factored out into a more convenient location, but its use of alloca makes that tricky to do. */ diff --git a/test-suite/lib.scm b/test-suite/lib.scm index a2390da67..1e78c71cf 100644 --- a/test-suite/lib.scm +++ b/test-suite/lib.scm @@ -269,7 +269,7 @@ with-locale with-locale* (define exception:system-error (cons 'system-error ".*")) (define exception:encoding-error - (cons 'misc-error "(cannot convert to output locale|input locale conversion error)")) + (cons 'encoding-error "(cannot convert to output locale|input locale conversion error)")) (define exception:miscellaneous-error (cons 'misc-error "^.*")) (define exception:read-error diff --git a/test-suite/tests/encoding-escapes.test b/test-suite/tests/encoding-escapes.test index 85f613f49..01b2e202b 100644 --- a/test-suite/tests/encoding-escapes.test +++ b/test-suite/tests/encoding-escapes.test @@ -1,6 +1,6 @@ ;;;; encoding-escapes.test --- test suite for Guile's string encodings -*- mode: scheme; coding: utf-8 -*- ;;;; -;;;; Copyright (C) 2009 Free Software Foundation, Inc. +;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -20,9 +20,6 @@ #:use-module (test-suite lib) #:use-module (srfi srfi-1)) -(define exception:conversion - (cons 'misc-error "^cannot convert to output locale")) - ;; Create a string from integer char values, eg. (string-ints 65) => "A" (define (string-ints . args) (apply string (map integer->char args))) @@ -71,14 +68,14 @@ (with-test-prefix "display output errors" (pass-if-exception "ultima" - exception:conversion + 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:conversion + exception:encoding-error (let ((pt (open-output-string))) (set-port-encoding! pt "ASCII") (set-port-conversion-strategy! pt 'error) diff --git a/test-suite/tests/encoding-iso88591.test b/test-suite/tests/encoding-iso88591.test index 32d2ed511..bcc8aa75a 100644 --- a/test-suite/tests/encoding-iso88591.test +++ b/test-suite/tests/encoding-iso88591.test @@ -1,6 +1,6 @@ ;;;; encoding-iso88591.test --- test suite for Guile's string encodings -*- mode: scheme; coding: iso-8859-1 -*- ;;;; -;;;; Copyright (C) 2009 Free Software Foundation, Inc. +;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -20,9 +20,6 @@ #:use-module (test-suite lib) #:use-module (srfi srfi-1)) -(define exception:conversion - (cons 'misc-error "^cannot convert to output locale")) - ;; Create a string from integer char values, eg. (string-ints 65) => "A" (define (string-ints . args) (apply string (map integer->char args))) @@ -167,7 +164,7 @@ (with-test-prefix "output errors" - (pass-if-exception "char 256" exception:conversion + (pass-if-exception "char 256" exception:encoding-error (let ((pt (open-output-string))) (set-port-encoding! pt "ISO-8859-1") (set-port-conversion-strategy! pt 'error) diff --git a/test-suite/tests/encoding-iso88597.test b/test-suite/tests/encoding-iso88597.test index eae3fab4d..f11619459 100644 --- a/test-suite/tests/encoding-iso88597.test +++ b/test-suite/tests/encoding-iso88597.test @@ -1,6 +1,6 @@ ;;;; encoding-iso88697.test --- test suite for Guile's string encodings -*- mode: scheme; coding: iso-8859-7 -*- ;;;; -;;;; Copyright (C) 2009 Free Software Foundation, Inc. +;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -20,9 +20,6 @@ #:use-module (test-suite lib) #:use-module (srfi srfi-1)) -(define exception:conversion - (cons 'misc-error "^cannot convert to output locale")) - ;; Create a string from integer char values, eg. (string-ints 65) => "A" (define (string-ints . args) (apply string (map integer->char args))) @@ -165,7 +162,7 @@ (with-test-prefix "output errors" (pass-if-exception "char #x0400" - exception:conversion + exception:encoding-error (let ((pt (open-output-string))) (set-port-encoding! pt "ISO-8859-7") (set-port-conversion-strategy! pt 'error) diff --git a/test-suite/tests/encoding-utf8.test b/test-suite/tests/encoding-utf8.test index d5e637048..b82994c3a 100644 --- a/test-suite/tests/encoding-utf8.test +++ b/test-suite/tests/encoding-utf8.test @@ -1,6 +1,6 @@ ;;;; encoding-utf8.test --- test suite for Guile's string encodings -*- mode: scheme; coding: utf-8 -*- ;;;; -;;;; Copyright (C) 2009 Free Software Foundation, Inc. +;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -20,9 +20,6 @@ #:use-module (test-suite lib) #:use-module (srfi srfi-1)) -(define exception:conversion - (cons 'misc-error "^cannot convert to output locale")) - ;; Create a string from integer char values, eg. (string-ints 65) => "A" (define (string-ints . args) (apply string (map integer->char args)))