mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 19:50:24 +02:00
Simplify `scm_i_set_port_encoding_x'.
* libguile/ports.c (find_valid_encoding): Remove. (scm_i_set_port_encoding_x): Remove call to `find_valid_encoding'. Remove `valid_enc'. Rename `enc' to `encoding'. * test-suite/tests/ports.test ("port-encoding"): New test prefix.
This commit is contained in:
parent
fe949e7bc6
commit
064c27c4ef
2 changed files with 26 additions and 51 deletions
|
@ -1999,48 +1999,11 @@ scm_i_get_port_encoding (SCM port)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Returns ENC if it is a recognized encoding. If it isn't, it tries
|
|
||||||
to find an alias of ENC that is valid. Otherwise, it returns
|
|
||||||
NULL. */
|
|
||||||
static const char *
|
|
||||||
find_valid_encoding (const char *enc)
|
|
||||||
{
|
|
||||||
int isvalid = 0;
|
|
||||||
const char str[] = " ";
|
|
||||||
scm_t_uint32 result_buf;
|
|
||||||
scm_t_uint32 *u32;
|
|
||||||
size_t u32len;
|
|
||||||
|
|
||||||
u32len = sizeof (result_buf) / sizeof (scm_t_uint32);
|
|
||||||
u32 = u32_conv_from_encoding (enc, iconveh_error, str, 1,
|
|
||||||
NULL, &result_buf, &u32len);
|
|
||||||
isvalid = (u32 != NULL);
|
|
||||||
|
|
||||||
if (SCM_UNLIKELY (u32 != &result_buf))
|
|
||||||
free (u32);
|
|
||||||
|
|
||||||
if (isvalid)
|
|
||||||
return enc;
|
|
||||||
|
|
||||||
return NULL;
|
|
||||||
}
|
|
||||||
|
|
||||||
void
|
void
|
||||||
scm_i_set_port_encoding_x (SCM port, const char *enc)
|
scm_i_set_port_encoding_x (SCM port, const char *encoding)
|
||||||
{
|
{
|
||||||
const char *valid_enc;
|
|
||||||
scm_t_port *pt;
|
scm_t_port *pt;
|
||||||
|
|
||||||
/* Null is shorthand for the native, Latin-1 encoding. */
|
|
||||||
if (enc == NULL)
|
|
||||||
valid_enc = NULL;
|
|
||||||
else
|
|
||||||
{
|
|
||||||
valid_enc = find_valid_encoding (enc);
|
|
||||||
if (valid_enc == NULL)
|
|
||||||
goto invalid_encoding;
|
|
||||||
}
|
|
||||||
|
|
||||||
if (scm_is_false (port))
|
if (scm_is_false (port))
|
||||||
{
|
{
|
||||||
/* Set the default encoding for future ports. */
|
/* Set the default encoding for future ports. */
|
||||||
|
@ -2049,14 +2012,14 @@ scm_i_set_port_encoding_x (SCM port, const char *enc)
|
||||||
scm_misc_error (NULL, "tried to set port encoding fluid before it is initialized",
|
scm_misc_error (NULL, "tried to set port encoding fluid before it is initialized",
|
||||||
SCM_EOL);
|
SCM_EOL);
|
||||||
|
|
||||||
if (valid_enc == NULL
|
if (encoding == NULL
|
||||||
|| !strcmp (valid_enc, "ASCII")
|
|| !strcmp (encoding, "ASCII")
|
||||||
|| !strcmp (valid_enc, "ANSI_X3.4-1968")
|
|| !strcmp (encoding, "ANSI_X3.4-1968")
|
||||||
|| !strcmp (valid_enc, "ISO-8859-1"))
|
|| !strcmp (encoding, "ISO-8859-1"))
|
||||||
scm_fluid_set_x (SCM_VARIABLE_REF (default_port_encoding_var), SCM_BOOL_F);
|
scm_fluid_set_x (SCM_VARIABLE_REF (default_port_encoding_var), SCM_BOOL_F);
|
||||||
else
|
else
|
||||||
scm_fluid_set_x (SCM_VARIABLE_REF (default_port_encoding_var),
|
scm_fluid_set_x (SCM_VARIABLE_REF (default_port_encoding_var),
|
||||||
scm_from_locale_string (valid_enc));
|
scm_from_locale_string (encoding));
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
|
@ -2068,26 +2031,26 @@ scm_i_set_port_encoding_x (SCM port, const char *enc)
|
||||||
/* Set the character encoding for this port. */
|
/* Set the character encoding for this port. */
|
||||||
pt = SCM_PTAB_ENTRY (port);
|
pt = SCM_PTAB_ENTRY (port);
|
||||||
|
|
||||||
if (valid_enc == NULL)
|
if (encoding == NULL)
|
||||||
valid_enc = "ISO-8859-1";
|
encoding = "ISO-8859-1";
|
||||||
|
|
||||||
pt->encoding = scm_gc_strdup (valid_enc, "port");
|
pt->encoding = scm_gc_strdup (encoding, "port");
|
||||||
|
|
||||||
if (SCM_CELL_WORD_0 (port) & SCM_RDNG)
|
if (SCM_CELL_WORD_0 (port) & SCM_RDNG)
|
||||||
{
|
{
|
||||||
/* Open an input iconv conversion descriptor, from VALID_ENC
|
/* Open an input iconv conversion descriptor, from ENCODING
|
||||||
to UTF-8. We choose UTF-8, not UTF-32, because iconv
|
to UTF-8. We choose UTF-8, not UTF-32, because iconv
|
||||||
implementations can typically convert from anything to
|
implementations can typically convert from anything to
|
||||||
UTF-8, but not to UTF-32 (see
|
UTF-8, but not to UTF-32 (see
|
||||||
<http://lists.gnu.org/archive/html/bug-libunistring/2010-09/msg00007.html>). */
|
<http://lists.gnu.org/archive/html/bug-libunistring/2010-09/msg00007.html>). */
|
||||||
new_input_cd = iconv_open ("UTF-8", valid_enc);
|
new_input_cd = iconv_open ("UTF-8", encoding);
|
||||||
if (new_input_cd == (iconv_t) -1)
|
if (new_input_cd == (iconv_t) -1)
|
||||||
goto invalid_encoding;
|
goto invalid_encoding;
|
||||||
}
|
}
|
||||||
|
|
||||||
if (SCM_CELL_WORD_0 (port) & SCM_WRTNG)
|
if (SCM_CELL_WORD_0 (port) & SCM_WRTNG)
|
||||||
{
|
{
|
||||||
new_output_cd = iconv_open (valid_enc, "UTF-8");
|
new_output_cd = iconv_open (encoding, "UTF-8");
|
||||||
if (new_output_cd == (iconv_t) -1)
|
if (new_output_cd == (iconv_t) -1)
|
||||||
{
|
{
|
||||||
if (new_input_cd != (iconv_t) -1)
|
if (new_input_cd != (iconv_t) -1)
|
||||||
|
@ -2110,8 +2073,9 @@ scm_i_set_port_encoding_x (SCM port, const char *enc)
|
||||||
invalid_encoding:
|
invalid_encoding:
|
||||||
{
|
{
|
||||||
SCM err;
|
SCM err;
|
||||||
err = scm_from_locale_string (enc);
|
err = scm_from_locale_string (encoding);
|
||||||
scm_misc_error (NULL, "invalid or unknown character encoding ~s",
|
scm_misc_error ("scm_i_set_port_encoding_x",
|
||||||
|
"invalid or unknown character encoding ~s",
|
||||||
scm_list_1 (err));
|
scm_list_1 (err));
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
|
@ -783,6 +783,17 @@
|
||||||
(set-port-line! port n)
|
(set-port-line! port n)
|
||||||
(eqv? n (port-line port)))))
|
(eqv? n (port-line port)))))
|
||||||
|
|
||||||
|
(with-test-prefix "port-encoding"
|
||||||
|
|
||||||
|
(pass-if-exception "set-port-encoding!, wrong encoding"
|
||||||
|
exception:miscellaneous-error
|
||||||
|
(set-port-encoding! (open-input-string "") "does-not-exist"))
|
||||||
|
|
||||||
|
(pass-if-exception "%default-port-encoding, wrong encoding"
|
||||||
|
exception:miscellaneous-error
|
||||||
|
(read (with-fluids ((%default-port-encoding "does-not-exist"))
|
||||||
|
(open-input-string "")))))
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
;;; port-for-each
|
;;; port-for-each
|
||||||
;;;
|
;;;
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue