[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. release_1-9-6-86-g8ff
|
From: |
Ludovic Courtès |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. release_1-9-6-86-g8ffcf6e |
|
Date: |
Thu, 07 Jan 2010 10:12:42 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=8ffcf6e725f97a4f3480ef6583743d7786e42997
The branch, master has been updated
via 8ffcf6e725f97a4f3480ef6583743d7786e42997 (commit)
via e29dcaf3b7dde40b960455587142e7a79c53bfab (commit)
via daa4a3f1ff34840f83705011780d62a5f4a56508 (commit)
via a3d7d5d50806fdfb80f44f53c7d990cf79a8d566 (commit)
via 7b0419128bce68f48a158292430ed4a7202aa1b1 (commit)
via 29bcdbb05948a5f12d2d8cb36a0c3c582e738be3 (commit)
from 9fdee5b40b190585f3fac949a366dfcf06ad202a (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 8ffcf6e725f97a4f3480ef6583743d7786e42997
Author: Ludovic Courtès <address@hidden>
Date: Wed Jan 6 23:55:13 2010 +0100
Enclose hooks tests in their own module.
* test-suite/tests/hooks.test: Enclose in `(test-suite test-hooks)'
module.
commit e29dcaf3b7dde40b960455587142e7a79c53bfab
Author: Ludovic Courtès <address@hidden>
Date: Wed Jan 6 23:54:21 2010 +0100
Fix 1.8-compatibility of `scm_search_path ()'.
* libguile/load.c (scm_search_path): Handle the 1.8-compatibility case
where REST is `SCM_UNDEFINED'. Reported by Dale P. Smith.
commit daa4a3f1ff34840f83705011780d62a5f4a56508
Author: Ludovic Courtès <address@hidden>
Date: Thu Jan 7 10:41:17 2010 +0100
Use Gnulib's `full-write' instead of custom code.
* libguile/fports.c (write_all): Remove.
(fport_write): Use `full_write ()' instead of `write_all ()'.
commit a3d7d5d50806fdfb80f44f53c7d990cf79a8d566
Author: Ludovic Courtès <address@hidden>
Date: Thu Jan 7 00:37:10 2010 +0100
Use `encoding-error' instead of `misc-error' for string encoding errors.
* libguile/strings.c (scm_encoding_error): New function.
(scm_from_stringn, scm_to_stringn): Use it instead of `scm_misc_error ()'.
* test-suite/lib.scm (exception:encoding-error): Adjust accordingly.
* test-suite/tests/encoding-escapes.test (exception:conversion):
Remove. Use `exception:encoding-error' instead.
* test-suite/tests/encoding-iso88591.test: Likewise.
* test-suite/tests/encoding-iso88597.test: Likewise.
* test-suite/tests/encoding-utf8.test: Likewise.
commit 7b0419128bce68f48a158292430ed4a7202aa1b1
Author: Ludovic Courtès <address@hidden>
Date: Thu Jan 7 11:00:37 2010 +0100
Have string ports honor `%default-port-encoding'.
* libguile/strports.c (scm_i_mkstrport): Remove.
(scm_mkstrport): Don't change the port's encoding to UTF-8; convert
STR to the default port encoding.
(scm_strport_to_string): Fix documentation & indentation.
* libguile/strports.h (scm_i_mkstrport): Remove.
* test-suite/lib.scm (exception:encoding-error): New variable.
(format-test-name): Set `%default-port-encoding' to "UTF-8".
* test-suite/tests/ports.test ("string ports")["%default-port-encoding
is honored", "suitable encoding [latin-1]", "suitable encoding
[latin-3]", "wrong encoding"]: New tests.
* test-suite/tests/r6rs-ports.test ("7.2.11 Binary
Output")["put-bytevector with UTF-16 string port", "put-bytevector
with wrong-encoding string port"]: New tests.
* test-suite/tests/reader.test (read-string): Set
`%default-port-encoding' to `#f'.
("reading")["unprintable symbol"]: Use a string that doesn't contain
zeros.
* doc/ref/api-io.texi (String Ports): Document encoding issues with
`call-with-output-string' and `with-output-to-string'.
commit 29bcdbb05948a5f12d2d8cb36a0c3c582e738be3
Author: Ludovic Courtès <address@hidden>
Date: Wed Jan 6 23:52:40 2010 +0100
Add in-source documentation of `scm_to_stringn ()'.
* libguile/strings.c (scm_to_stringn): Add documentation comment.
-----------------------------------------------------------------------
Summary of changes:
doc/ref/api-io.texi | 26 +++++++++-
libguile/fports.c | 37 ++++----------
libguile/load.c | 7 ++-
libguile/strings.c | 43 ++++++++++------
libguile/strports.c | 84 +++++++++++--------------------
libguile/strports.h | 4 +-
test-suite/lib.scm | 26 ++++++----
test-suite/tests/encoding-escapes.test | 9 +--
test-suite/tests/encoding-iso88591.test | 7 +--
test-suite/tests/encoding-iso88597.test | 7 +--
test-suite/tests/encoding-utf8.test | 5 +--
test-suite/tests/hooks.test | 5 ++-
test-suite/tests/ports.test | 41 ++++++++++++++-
test-suite/tests/r6rs-ports.test | 26 ++++++++--
test-suite/tests/reader.test | 11 ++--
15 files changed, 192 insertions(+), 146 deletions(-)
diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi
index eb5338c..a1f4221 100644
--- a/doc/ref/api-io.texi
+++ b/doc/ref/api-io.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007,
2009
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007,
2009, 2010
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@@ -972,6 +972,28 @@ away from its default.
Calls the one-argument procedure @var{proc} with a newly created output
port. When the function returns, the string composed of the characters
written into the port is returned. @var{proc} should not close the port.
+
+Note that which characters can be written to a string port depend on the port's
+encoding. The default encoding of string ports is specified by the
address@hidden fluid (@pxref{Ports,
address@hidden). For instance, it is an error to write Greek
+letter alpha to an ISO-8859-1-encoded string port since this character cannot
be
+represented with ISO-8859-1:
+
address@hidden
+(define alpha (integer->char #x03b1)) ; GREEK SMALL LETTER ALPHA
+
+(with-fluids ((%default-port-encoding "ISO-8859-1"))
+ (call-with-output-string
+ (lambda (p)
+ (display alpha p))))
+
address@hidden
+Throw to key `encoding-error'
address@hidden example
+
+Changing the string port's encoding to a Unicode-capable encoding such as UTF-8
+solves the problem.
@end deffn
@deffn {Scheme Procedure} call-with-input-string string proc
@@ -985,6 +1007,8 @@ read. The value yielded by the @var{proc} is returned.
Calls the zero-argument procedure @var{thunk} with the current output
port set temporarily to a new string port. It returns a string
composed of the characters written to the current output.
+
+See @code{call-with-output-string} above for character encoding considerations.
@end deffn
@deffn {Scheme Procedure} with-input-from-string string thunk
diff --git a/libguile/fports.c b/libguile/fports.c
index 3e911f2..232c436 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006,
2007, 2008, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006,
2007, 2008, 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 License
@@ -688,29 +688,9 @@ fport_truncate (SCM port, scm_t_off length)
scm_syserror ("ftruncate");
}
-/* helper for fport_write: try to write data, using multiple system
- calls if required. */
-#define FUNC_NAME "write_all"
-static void write_all (SCM port, const void *data, size_t remaining)
-{
- int fdes = SCM_FSTREAM (port)->fdes;
-
- while (remaining > 0)
- {
- size_t done;
-
- SCM_SYSCALL (done = write (fdes, data, remaining));
-
- if (done == -1)
- SCM_SYSERROR;
- remaining -= done;
- data = ((const char *) data) + done;
- }
-}
-#undef FUNC_NAME
-
static void
fport_write (SCM port, const void *data, size_t size)
+#define FUNC_NAME "fport_write"
{
/* this procedure tries to minimize the number of writes/flushes. */
scm_t_port *pt = SCM_PTAB_ENTRY (port);
@@ -718,9 +698,11 @@ fport_write (SCM port, const void *data, size_t size)
if (pt->write_buf == &pt->shortbuf
|| (pt->write_pos == pt->write_buf && size >= pt->write_buf_size))
{
- /* "unbuffered" port, or
- port with empty buffer and data won't fit in buffer. */
- write_all (port, data, size);
+ /* Unbuffered port, or port with empty buffer and data won't fit in
+ buffer. */
+ if (full_write (SCM_FPORT_FDES (port), data, size) < size)
+ SCM_SYSERROR;
+
return;
}
@@ -750,7 +732,9 @@ fport_write (SCM port, const void *data, size_t size)
if (size >= pt->write_buf_size)
{
- write_all (port, ptr, remaining);
+ if (full_write (SCM_FPORT_FDES (port), ptr, remaining)
+ < remaining)
+ SCM_SYSERROR;
return;
}
else
@@ -766,6 +750,7 @@ fport_write (SCM port, const void *data, size_t size)
fport_flush (port);
}
}
+#undef FUNC_NAME
/* becomes 1 when process is exiting: normal exception handling won't
work by this time. */
diff --git a/libguile/load.c b/libguile/load.c
index dbe80f6..7c2dcfb 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2004, 2006, 2008, 2009 Free
Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2004, 2006, 2008, 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 License
@@ -407,11 +407,12 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 0, 1,
SCM extensions, require_exts;
SCM result = SCM_BOOL_F;
- if (scm_is_null (rest))
+ if (SCM_UNBNDP (rest) || scm_is_null (rest))
{
/* Called either by Scheme code that didn't provide the optional
arguments, or C code that used the Guile 1.8 signature (2 required,
- 1 optional arg) and passed '() as the EXTENSIONS argument. */
+ 1 optional arg) and passed '() or nothing as the EXTENSIONS
+ argument. */
extensions = SCM_EOL;
require_exts = SCM_UNDEFINED;
}
diff --git a/libguile/strings.c b/libguile/strings.c
index d3bb325..4ae07a2 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,2000,2001, 2004, 2006, 2008, 2009 Free
Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000,2001, 2004, 2006, 2008, 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 License
@@ -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);
}
}
@@ -1605,7 +1617,10 @@ scm_to_locale_stringn (SCM str, size_t *lenp)
scm_i_get_conversion_strategy (SCM_BOOL_F));
}
-/* Low-level scheme to C string conversion function. */
+/* Return a malloc(3)-allocated buffer containing the contents of STR encoded
+ according to ENCODING. If LENP is non-NULL, set it to the size in bytes of
+ the returned buffer. If the conversion to ENCODING fails, apply the
strategy
+ defined by HANDLER. */
char *
scm_to_stringn (SCM str, size_t *lenp, const char *encoding,
scm_t_string_failed_conversion_handler handler)
@@ -1672,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
{
@@ -1687,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);
}
@@ -1737,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/libguile/strports.c b/libguile/strports.c
index 95e93c9..625b753 100644
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002, 2003, 2005, 2006, 2009
Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002, 2003, 2005, 2006, 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 License
@@ -289,84 +289,60 @@ st_truncate (SCM port, scm_t_off length)
pt->write_pos = pt->read_end;
}
-SCM
-scm_i_mkstrport (SCM pos, const char *utf8_str, size_t str_len, long modes,
const char *caller)
+SCM
+scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
{
- SCM z, str;
+ SCM z;
scm_t_port *pt;
- size_t c_pos;
- char *buf;
-
- /* Because ports are inherently 8-bit, strings need to be converted
- to a locale representation for storage. But, since string ports
- rely on string functionality for their memory management, we need
- to create a new string that has the 8-bit locale representation
- of the underlying string.
+ size_t str_len, c_pos;
+ char *buf, *c_str;
- locale_str is already in the locale of the port. */
- str = scm_i_make_string (str_len, &buf);
- memcpy (buf, utf8_str, str_len);
-
- c_pos = scm_to_unsigned_integer (pos, 0, str_len);
+ SCM_ASSERT (scm_is_string (str), str, SCM_ARG1, caller);
+ c_pos = scm_to_unsigned_integer (pos, 0, scm_i_string_length (str));
if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG)))
scm_misc_error ("scm_mkstrport", "port must read or write", SCM_EOL);
- scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
+ scm_dynwind_begin (0);
+ scm_i_dynwind_pthread_mutex_lock (&scm_i_port_table_mutex);
+
z = scm_new_port_table_entry (scm_tc16_strport);
pt = SCM_PTAB_ENTRY(z);
SCM_SETSTREAM (z, SCM_UNPACK (str));
- SCM_SET_CELL_TYPE(z, scm_tc16_strport|modes);
- pt->write_buf = pt->read_buf = (unsigned char *) scm_i_string_chars (str);
+ SCM_SET_CELL_TYPE (z, scm_tc16_strport | modes);
+
+ /* Create a copy of STR in the encoding of Z. */
+ buf = scm_to_stringn (str, &str_len, pt->encoding,
+ SCM_FAILED_CONVERSION_ERROR);
+ c_str = scm_gc_malloc (str_len, "strport");
+ memcpy (c_str, buf, str_len);
+ free (buf);
+
+ pt->write_buf = pt->read_buf = (unsigned char *) c_str;
pt->read_pos = pt->write_pos = pt->read_buf + c_pos;
pt->write_buf_size = pt->read_buf_size = str_len;
pt->write_end = pt->read_end = pt->read_buf + pt->read_buf_size;
pt->rw_random = 1;
- scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
- /* ensure write_pos is writable. */
+ scm_dynwind_end ();
+
+ /* Ensure WRITE_POS is writable. */
if ((modes & SCM_WRTNG) && pt->write_pos == pt->write_end)
st_flush (z);
- scm_i_set_port_encoding_x (z, "UTF-8");
scm_i_set_conversion_strategy_x (z, SCM_FAILED_CONVERSION_ERROR);
return z;
}
-SCM
-scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
-{
- SCM z;
- size_t str_len;
- char *buf;
-
- SCM_ASSERT (scm_is_string (str), str, SCM_ARG1, caller);
-
- /* Because ports are inherently 8-bit, strings need to be converted
- to a locale representation for storage. But, since string ports
- rely on string functionality for their memory management, we need
- to create a new string that has the 8-bit locale representation
- of the underlying string. This violates the guideline that the
- internal encoding of characters in strings is in unicode
- codepoints. */
-
- /* String ports are are always initialized with "UTF-8" as their
- encoding. */
- buf = scm_to_stringn (str, &str_len, "UTF-8", SCM_FAILED_CONVERSION_ERROR);
- z = scm_i_mkstrport (pos, buf, str_len, modes, caller);
- free (buf);
- return z;
-}
-
-/* Create a new string from a string port's buffer, converting from
- the port's 8-bit locale-specific representation to the standard
- string representation. */
-SCM scm_strport_to_string (SCM port)
+/* Create a new string from the buffer of PORT, a string port, converting from
+ PORT's encoding to the standard string representation. */
+SCM
+scm_strport_to_string (SCM port)
{
- scm_t_port *pt = SCM_PTAB_ENTRY (port);
SCM str;
-
+ scm_t_port *pt = SCM_PTAB_ENTRY (port);
+
if (pt->rw_active == SCM_PORT_WRITE)
st_flush (port);
diff --git a/libguile/strports.h b/libguile/strports.h
index d93266a..3a9c3ec 100644
--- a/libguile/strports.h
+++ b/libguile/strports.h
@@ -3,7 +3,7 @@
#ifndef SCM_STRPORTS_H
#define SCM_STRPORTS_H
-/* Copyright (C) 1995,1996,2000,2001,2002, 2006, 2008 Free Software
Foundation, Inc.
+/* Copyright (C) 1995,1996,2000,2001,2002, 2006, 2008, 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 License
@@ -44,8 +44,6 @@ SCM_API scm_t_bits scm_tc16_strport;
SCM_API SCM scm_mkstrport (SCM pos, SCM str, long modes, const char * caller);
-SCM_INTERNAL SCM scm_i_mkstrport (SCM pos, const char *locale_str, size_t
str_len,
- long modes, const char *caller);
SCM_API SCM scm_strport_to_string (SCM port);
SCM_API SCM scm_object_to_string (SCM obj, SCM printer);
SCM_API SCM scm_call_with_output_string (SCM proc);
diff --git a/test-suite/lib.scm b/test-suite/lib.scm
index e5b7a08..1e78c71 100644
--- a/test-suite/lib.scm
+++ b/test-suite/lib.scm
@@ -1,5 +1,5 @@
;;;; test-suite/lib.scm --- generic support for testing
-;;;; Copyright (C) 1999, 2000, 2001, 2004, 2006, 2007, 2009 Free Software
Foundation, Inc.
+;;;; Copyright (C) 1999, 2000, 2001, 2004, 2006, 2007, 2009, 2010 Free
Software Foundation, Inc.
;;;;
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -30,6 +30,7 @@
exception:numerical-overflow
exception:struct-set!-denied
exception:system-error
+ exception:encoding-error
exception:miscellaneous-error
exception:string-contains-nul
exception:read-error
@@ -267,6 +268,8 @@ with-locale with-locale*
(cons 'misc-error "^set! denied for field"))
(define exception:system-error
(cons 'system-error ".*"))
+(define exception:encoding-error
+ (cons 'encoding-error "(cannot convert to output locale|input locale
conversion error)"))
(define exception:miscellaneous-error
(cons 'misc-error "^.*"))
(define exception:read-error
@@ -389,15 +392,18 @@ with-locale with-locale*
;;;; Turn a test name into a nice human-readable string.
(define (format-test-name name)
- (call-with-output-string
- (lambda (port)
- (let loop ((name name)
- (separator ""))
- (if (pair? name)
- (begin
- (display separator port)
- (display (car name) port)
- (loop (cdr name) ": ")))))))
+ ;; Choose a Unicode-capable encoding so that the string port can contain any
+ ;; valid Unicode character.
+ (with-fluids ((%default-port-encoding "UTF-8"))
+ (call-with-output-string
+ (lambda (port)
+ (let loop ((name name)
+ (separator ""))
+ (if (pair? name)
+ (begin
+ (display separator port)
+ (display (car name) port)
+ (loop (cdr name) ": "))))))))
;;;; For a given test-name, deliver the full name including all prefixes.
(define (full-name name)
diff --git a/test-suite/tests/encoding-escapes.test
b/test-suite/tests/encoding-escapes.test
index 85f613f..01b2e20 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 32d2ed5..bcc8aa7 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 eae3fab..f116194 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 d5e6370..b82994c 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)))
diff --git a/test-suite/tests/hooks.test b/test-suite/tests/hooks.test
index 0987f8c..e6beb49 100644
--- a/test-suite/tests/hooks.test
+++ b/test-suite/tests/hooks.test
@@ -1,5 +1,5 @@
;;;; hooks.test --- tests guile's hooks implementation -*- scheme -*-
-;;;; Copyright (C) 1999, 2001, 2006, 2009 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2001, 2006, 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
@@ -15,6 +15,9 @@
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
+(define-module (test-suite test-hooks)
+ #:use-module (test-suite lib))
+
;;;
;;; miscellaneous
;;;
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 312467d..72dcb63 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -1,7 +1,7 @@
-;;;; ports.test --- test suite for Guile I/O ports -*- scheme -*-
+;;;; ports.test --- Guile I/O ports. -*- coding: utf-8; mode: scheme; -*-
;;;; Jim Blandy <address@hidden> --- May 1999
;;;;
-;;;; Copyright (C) 1999, 2001, 2004, 2006, 2007, 2009 Free Software
Foundation, Inc.
+;;;; Copyright (C) 1999, 2001, 2004, 2006, 2007, 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
@@ -307,7 +307,42 @@
(string-set! text 0 #\a)
(string-set! text (- len 1) #\b)
(pass-if "output check"
- (string=? text result))))
+ (string=? text result)))
+
+ (pass-if "%default-port-encoding is honored"
+ (let ((encodings '("UTF-8" "UTF-16" "ISO-8859-1" "ISO-8859-3")))
+ (equal? (map (lambda (e)
+ (with-fluids ((%default-port-encoding e))
+ (call-with-output-string
+ (lambda (p)
+ (display (port-encoding p) p)))))
+ encodings)
+ encodings)))
+
+ (pass-if "suitable encoding [latin-1]"
+ (let ((str "hello, world"))
+ (with-fluids ((%default-port-encoding "ISO-8859-1"))
+ (equal? str
+ (with-output-to-string
+ (lambda ()
+ (display str)))))))
+
+ (pass-if "suitable encoding [latin-3]"
+ (let ((str "Äu bone?"))
+ (with-fluids ((%default-port-encoding "ISO-8859-3"))
+ (equal? str
+ (with-output-to-string
+ (lambda ()
+ (display str)))))))
+
+ (pass-if-exception "wrong encoding"
+ exception:encoding-error
+ (let ((str "Äu bone?"))
+ ;; Latin-1 cannot represent âÄâ.
+ (with-fluids ((%default-port-encoding "ISO-8859-1"))
+ (with-output-to-string
+ (lambda ()
+ (display str)))))))
(with-test-prefix "call-with-output-string"
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
index eb60cf3..1d60991 100644
--- a/test-suite/tests/r6rs-ports.test
+++ b/test-suite/tests/r6rs-ports.test
@@ -1,6 +1,6 @@
-;;;; r6rs-ports.test --- Exercise the R6RS I/O port API.
+;;;; r6rs-ports.test --- R6RS I/O port tests. -*- coding: iso-8859-1; -*-
;;;;
-;;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;;;; Ludovic Courtès
;;;;
;;;; This library is free software; you can redistribute it and/or
@@ -219,7 +219,25 @@
(port (%make-void-port "w")))
(close-port port)
- (put-bytevector port bv))))
+ (put-bytevector port bv)))
+
+ (pass-if "put-bytevector with UTF-16 string port"
+ (let* ((str "hello, world")
+ (bv (string->utf16 str)))
+ (equal? str
+ (with-fluids ((%default-port-encoding "UTF-16BE"))
+ (call-with-output-string
+ (lambda (port)
+ (put-bytevector port bv)))))))
+
+ (pass-if-exception "put-bytevector with wrong-encoding string port"
+ exception:encoding-error
+ (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)))))))
(with-test-prefix "7.2.7 Input Ports"
@@ -452,8 +470,6 @@
(not eof?)
(bytevector=? sink source)))))
-
;;; Local Variables:
-;;; coding: latin-1
;;; mode: scheme
;;; End:
diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test
index 2ee21c1..b819e63 100644
--- a/test-suite/tests/reader.test
+++ b/test-suite/tests/reader.test
@@ -1,6 +1,6 @@
-;;;; reader.test --- Exercise the reader. -*- Scheme -*-
+;;;; reader.test --- Reader test. -*- coding: iso-8859-1; mode: scheme -*-
;;;;
-;;;; Copyright (C) 1999, 2001, 2002, 2003, 2007, 2008, 2009 Free Software
Foundation, Inc.
+;;;; Copyright (C) 1999, 2001, 2002, 2003, 2007, 2008, 2009, 2010 Free
Software Foundation, Inc.
;;;; Jim Blandy <address@hidden>
;;;;
;;;; This library is free software; you can redistribute it and/or
@@ -41,7 +41,8 @@
(define (read-string s)
- (with-input-from-string s (lambda () (read))))
+ (with-fluids ((%default-port-encoding #f))
+ (with-input-from-string s (lambda () (read)))))
(define (with-read-options opts thunk)
(let ((saved-options (read-options)))
@@ -110,8 +111,8 @@
(pass-if "unprintable symbol"
;; The reader tolerates unprintable characters for symbols.
- (equal? (string->symbol "\001\002\003")
- (read-string "\001\002\003")))
+ (equal? (string->symbol "\x01\x02\x03")
+ (read-string "\x01\x02\x03")))
(pass-if "CR recognized as a token delimiter"
;; In 1.8.3, character 0x0d was not recognized as a delimiter.
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. release_1-9-6-86-g8ffcf6e,
Ludovic Courtès <=