summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2012-05-29 23:39:05 +0200
committerLudovic Courtès <ludo@gnu.org>2012-05-31 00:50:36 +0200
commitb22e94db7c91d7661204e33f3bc2bfead002c9b7 (patch)
tree107acc1190f8ac32e8e12ccd3cff8dd0a0b9035c
parent478848cb706b23bcc4c2afe9a4ad33c595bc33f6 (diff)
downloadguile-b22e94db7c91d7661204e33f3bc2bfead002c9b7.tar.gz
Add the `%default-port-conversion-strategy' fluid.
Fixes <http://bugs.gnu.org/11468>. * libguile/ports.c (scm_conversion_strategy): Remove. (default_conversion_strategy_var, sym_error, sym_substitute, sym_escape): New variables. (scm_i_get_conversion_strategy, scm_i_set_conversion_strategy_x): Remove. (scm_i_default_port_conversion_handler, scm_i_set_default_port_conversion_handler): New functions. (scm_port_conversion_strategy): Use `scm_i_default_port_conversion_handler' when PORT is #f. (scm_set_port_conversion_strategy_x): Use SYM_ERROR, SYM_SUBSTITUTE, and SYM_ESCAPE. Use `scm_i_set_default_port_conversion_handler' when PORT is #f. (scm_init_ports): Initialize DEFAULT_CONVERSION_STRATEGY_VAR. * libguile/ports.h: Update declarations accordingly. * libguile/foreign.c: Change `scm_i_get_conversion_strategy (SCM_BOOL_F)' to `scm_i_default_port_conversion_handler ()'. * libguile/strings.c: Likewise. * test-suite/tests/ports.test ("%default-port-conversion-strategy"): New test prefix. * test-suite/tests/foreign.test ("pointer<->string")["%default-port-conversion-strategy is error", "%default-port-conversion-strategy is soft"]: New tests. * test-suite/test-suite/lib.scm (exception:encoding-error): Allow the regexp to match `scm_to_stringn' error messages. * doc/ref/api-io.texi (Ports): Document `%default-port-conversion-strategy'.
-rw-r--r--doc/ref/api-io.texi15
-rw-r--r--libguile/foreign.c4
-rw-r--r--libguile/ports.c167
-rw-r--r--libguile/ports.h9
-rw-r--r--libguile/strings.c6
-rw-r--r--test-suite/test-suite/lib.scm2
-rw-r--r--test-suite/tests/foreign.test17
-rw-r--r--test-suite/tests/ports.test28
8 files changed, 159 insertions, 89 deletions
diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi
index 24c2706df..de3684c31 100644
--- a/doc/ref/api-io.texi
+++ b/doc/ref/api-io.texi
@@ -166,6 +166,21 @@ returned. New ports will have this default behavior when they are
created.
@end deffn
+@deffn {Scheme Variable} %default-port-conversion-strategy
+The fluid that defines the conversion strategy for newly created ports,
+and for other conversion routines such as @code{scm_to_stringn},
+@code{scm_from_stringn}, @code{string->pointer}, and
+@code{pointer->string}.
+
+Its value must be one of the symbols described above, with the same
+semantics: @code{'error}, @code{'substitute}, or @code{'escape}.
+
+When Guile starts, its value is @code{'substitute}.
+
+Note that @code{(set-port-conversion-strategy! #f @var{sym})} is
+equivalent to @code{(fluid-set! %default-port-conversion-strategy
+@var{sym})}.
+@end deffn
@node Reading
diff --git a/libguile/foreign.c b/libguile/foreign.c
index f1d960717..355934962 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -375,7 +375,7 @@ SCM_DEFINE (scm_string_to_pointer, "string->pointer", 1, 1, 0,
ret = scm_from_pointer
(scm_to_stringn (string, NULL, enc,
- scm_i_get_conversion_strategy (SCM_BOOL_F)),
+ scm_i_default_port_conversion_handler ()),
free);
scm_dynwind_end ();
@@ -420,7 +420,7 @@ SCM_DEFINE (scm_pointer_to_string, "pointer->string", 1, 2, 0,
scm_dynwind_free (enc);
ret = scm_from_stringn (SCM_POINTER_VALUE (pointer), len, enc,
- scm_i_get_conversion_strategy (SCM_BOOL_F));
+ scm_i_default_port_conversion_handler ());
scm_dynwind_end ();
diff --git a/libguile/ports.c b/libguile/ports.c
index 3ef92b902..ccf658756 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -628,7 +628,7 @@ scm_new_port_table_entry (scm_t_bits tag)
entry->input_cd = (iconv_t) -1;
entry->output_cd = (iconv_t) -1;
- entry->ilseq_handler = scm_i_get_conversion_strategy (SCM_BOOL_F);
+ entry->ilseq_handler = scm_i_default_port_conversion_handler ();
SCM_SET_CELL_TYPE (z, tag);
SCM_SETPTAB_ENTRY (z, entry);
@@ -2309,62 +2309,81 @@ SCM_DEFINE (scm_set_port_encoding_x, "set-port-encoding!", 2, 0, 0,
#undef FUNC_NAME
-/* This determines how conversions handle unconvertible characters. */
-SCM_GLOBAL_VARIABLE (scm_conversion_strategy, "%port-conversion-strategy");
+/* A fluid specifying the default conversion handler for newly created
+ ports. Its value should be one of the symbols below. */
+SCM_VARIABLE (default_conversion_strategy_var,
+ "%default-port-conversion-strategy");
+
+/* Whether the above fluid is initialized. */
static int scm_conversion_strategy_init = 0;
+/* The possible conversion strategies. */
+SCM_SYMBOL (sym_error, "error");
+SCM_SYMBOL (sym_substitute, "substitute");
+SCM_SYMBOL (sym_escape, "escape");
+
+/* Return the default failed encoding conversion policy for new created
+ ports. */
scm_t_string_failed_conversion_handler
-scm_i_get_conversion_strategy (SCM port)
+scm_i_default_port_conversion_handler (void)
{
- SCM encoding;
-
- if (scm_is_false (port))
- {
- if (!scm_conversion_strategy_init
- || !scm_is_fluid (SCM_VARIABLE_REF (scm_conversion_strategy)))
- return SCM_FAILED_CONVERSION_QUESTION_MARK;
- else
- {
- encoding = scm_fluid_ref (SCM_VARIABLE_REF (scm_conversion_strategy));
- if (scm_is_false (encoding))
- return SCM_FAILED_CONVERSION_QUESTION_MARK;
- else
- return (scm_t_string_failed_conversion_handler) scm_to_int (encoding);
- }
- }
+ scm_t_string_failed_conversion_handler handler;
+
+ if (!scm_conversion_strategy_init
+ || !scm_is_fluid (SCM_VARIABLE_REF (default_conversion_strategy_var)))
+ handler = SCM_FAILED_CONVERSION_QUESTION_MARK;
else
{
- scm_t_port *pt;
- pt = SCM_PTAB_ENTRY (port);
- return pt->ilseq_handler;
+ SCM fluid, value;
+
+ fluid = SCM_VARIABLE_REF (default_conversion_strategy_var);
+ value = scm_fluid_ref (fluid);
+
+ if (scm_is_eq (sym_substitute, value))
+ handler = SCM_FAILED_CONVERSION_QUESTION_MARK;
+ else if (scm_is_eq (sym_escape, value))
+ handler = SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE;
+ else
+ /* Default to 'error also when the fluid's value is not one of
+ the valid symbols. */
+ handler = SCM_FAILED_CONVERSION_ERROR;
}
-
+
+ return handler;
}
+/* Use HANDLER as the default conversion strategy for future ports. */
void
-scm_i_set_conversion_strategy_x (SCM port,
- scm_t_string_failed_conversion_handler handler)
+scm_i_set_default_port_conversion_handler (scm_t_string_failed_conversion_handler
+ handler)
{
SCM strategy;
- scm_t_port *pt;
-
- strategy = scm_from_int ((int) handler);
-
- if (scm_is_false (port))
- {
- /* Set the default encoding for future ports. */
- if (!scm_conversion_strategy_init
- || !scm_is_fluid (SCM_VARIABLE_REF (scm_conversion_strategy)))
- scm_misc_error (NULL, "tried to set conversion strategy fluid before it is initialized",
- SCM_EOL);
- scm_fluid_set_x (SCM_VARIABLE_REF (scm_conversion_strategy), strategy);
- }
- else
+
+ if (!scm_conversion_strategy_init
+ || !scm_is_fluid (SCM_VARIABLE_REF (default_conversion_strategy_var)))
+ scm_misc_error (NULL, "tried to set conversion strategy fluid before it is initialized",
+ SCM_EOL);
+
+ switch (handler)
{
- /* Set the character encoding for this port. */
- pt = SCM_PTAB_ENTRY (port);
- pt->ilseq_handler = handler;
+ case SCM_FAILED_CONVERSION_ERROR:
+ strategy = sym_error;
+ break;
+
+ case SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE:
+ strategy = sym_escape;
+ break;
+
+ case SCM_FAILED_CONVERSION_QUESTION_MARK:
+ strategy = sym_substitute;
+ break;
+
+ default:
+ abort ();
}
+
+ scm_fluid_set_x (SCM_VARIABLE_REF (default_conversion_strategy_var),
+ strategy);
}
SCM_DEFINE (scm_port_conversion_strategy, "port-conversion-strategy",
@@ -2384,14 +2403,18 @@ SCM_DEFINE (scm_port_conversion_strategy, "port-conversion-strategy",
{
scm_t_string_failed_conversion_handler h;
- SCM_VALIDATE_OPPORT (1, port);
-
- if (!scm_is_false (port))
+ if (scm_is_false (port))
+ h = scm_i_default_port_conversion_handler ();
+ else
{
+ scm_t_port *pt;
+
SCM_VALIDATE_OPPORT (1, port);
+ pt = SCM_PTAB_ENTRY (port);
+
+ h = pt->ilseq_handler;
}
- h = scm_i_get_conversion_strategy (port);
if (h == SCM_FAILED_CONVERSION_ERROR)
return scm_from_latin1_symbol ("error");
else if (h == SCM_FAILED_CONVERSION_QUESTION_MARK)
@@ -2426,40 +2449,25 @@ SCM_DEFINE (scm_set_port_conversion_strategy_x, "set-port-conversion-strategy!",
"this thread.\n")
#define FUNC_NAME s_scm_set_port_conversion_strategy_x
{
- SCM err;
- SCM qm;
- SCM esc;
-
- if (!scm_is_false (port))
- {
- SCM_VALIDATE_OPPORT (1, port);
- }
-
- err = scm_from_latin1_symbol ("error");
- if (scm_is_true (scm_eqv_p (sym, err)))
- {
- scm_i_set_conversion_strategy_x (port, SCM_FAILED_CONVERSION_ERROR);
- return SCM_UNSPECIFIED;
- }
+ scm_t_string_failed_conversion_handler handler;
- qm = scm_from_latin1_symbol ("substitute");
- if (scm_is_true (scm_eqv_p (sym, qm)))
- {
- scm_i_set_conversion_strategy_x (port,
- SCM_FAILED_CONVERSION_QUESTION_MARK);
- return SCM_UNSPECIFIED;
- }
+ if (scm_is_eq (sym, sym_error))
+ handler = SCM_FAILED_CONVERSION_ERROR;
+ else if (scm_is_eq (sym, sym_substitute))
+ handler = SCM_FAILED_CONVERSION_QUESTION_MARK;
+ else if (scm_is_eq (sym, sym_escape))
+ handler = SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE;
+ else
+ SCM_MISC_ERROR ("unknown conversion strategy ~s", scm_list_1 (sym));
- esc = scm_from_latin1_symbol ("escape");
- if (scm_is_true (scm_eqv_p (sym, esc)))
+ if (scm_is_false (port))
+ scm_i_set_default_port_conversion_handler (handler);
+ else
{
- scm_i_set_conversion_strategy_x (port,
- SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE);
- return SCM_UNSPECIFIED;
+ SCM_VALIDATE_OPPORT (1, port);
+ SCM_PTAB_ENTRY (port)->ilseq_handler = handler;
}
- SCM_MISC_ERROR ("unknown conversion behavior ~s", scm_list_1 (sym));
-
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@@ -2577,11 +2585,10 @@ scm_init_ports ()
scm_make_fluid_with_default (SCM_BOOL_F));
scm_port_encoding_init = 1;
- SCM_VARIABLE_SET (scm_conversion_strategy,
- scm_make_fluid_with_default
- (scm_from_int ((int) SCM_FAILED_CONVERSION_QUESTION_MARK)));
+ SCM_VARIABLE_SET (default_conversion_strategy_var,
+ scm_make_fluid_with_default (sym_substitute));
scm_conversion_strategy_init = 1;
-
+
/* These bindings are used when boot-9 turns `current-input-port' et
al into parameters. They are then removed from the guile module. */
scm_c_define ("%current-input-port-fluid", cur_inport_fluid);
diff --git a/libguile/ports.h b/libguile/ports.h
index d1e1fd698..d4d59b70e 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -308,9 +308,12 @@ SCM_INTERNAL void scm_i_set_default_port_encoding (const char *);
SCM_INTERNAL void scm_i_set_port_encoding_x (SCM port, const char *str);
SCM_API SCM scm_port_encoding (SCM port);
SCM_API SCM scm_set_port_encoding_x (SCM port, SCM encoding);
-SCM_INTERNAL scm_t_string_failed_conversion_handler scm_i_get_conversion_strategy (SCM port);
-SCM_INTERNAL void scm_i_set_conversion_strategy_x (SCM port,
- scm_t_string_failed_conversion_handler h);
+SCM_INTERNAL scm_t_string_failed_conversion_handler
+scm_i_default_port_conversion_handler (void);
+/* Use HANDLER as the default conversion strategy for future ports. */
+SCM_INTERNAL void
+scm_i_set_default_port_conversion_handler (scm_t_string_failed_conversion_handler);
+
SCM_API SCM scm_port_conversion_strategy (SCM port);
SCM_API SCM scm_set_port_conversion_strategy_x (SCM port, SCM behavior);
SCM_API int scm_port_print (SCM exp, SCM port, scm_print_state *);
diff --git a/libguile/strings.c b/libguile/strings.c
index 07356fcaf..414951ee1 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -1577,7 +1577,7 @@ SCM
scm_from_locale_stringn (const char *str, size_t len)
{
return scm_from_stringn (str, len, locale_charset (),
- scm_i_get_conversion_strategy (SCM_BOOL_F));
+ scm_i_default_port_conversion_handler ());
}
SCM
@@ -1802,9 +1802,9 @@ scm_to_locale_string (SCM str)
char *
scm_to_locale_stringn (SCM str, size_t *lenp)
{
- return scm_to_stringn (str, lenp,
+ return scm_to_stringn (str, lenp,
locale_charset (),
- scm_i_get_conversion_strategy (SCM_BOOL_F));
+ scm_i_default_port_conversion_handler ());
}
char *
diff --git a/test-suite/test-suite/lib.scm b/test-suite/test-suite/lib.scm
index 5785378ad..385cdfae3 100644
--- a/test-suite/test-suite/lib.scm
+++ b/test-suite/test-suite/lib.scm
@@ -283,7 +283,7 @@
(define exception:system-error
(cons 'system-error ".*"))
(define exception:encoding-error
- (cons 'encoding-error "(cannot convert to output locale|input (locale conversion|decoding) error)"))
+ (cons 'encoding-error "(cannot convert.* to output locale|input (locale conversion|decoding) error)"))
(define exception:miscellaneous-error
(cons 'misc-error "^.*"))
(define exception:read-error
diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test
index 6eafe954a..14fad09e4 100644
--- a/test-suite/tests/foreign.test
+++ b/test-suite/tests/foreign.test
@@ -25,6 +25,7 @@
#:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
+ #:use-module (ice-9 format)
#:use-module (test-suite lib))
@@ -160,6 +161,22 @@
(with-test-prefix "pointer<->string"
+ (pass-if-exception "%default-port-conversion-strategy is error"
+ exception:encoding-error
+ (let ((s "χαοσ"))
+ (with-fluids ((%default-port-conversion-strategy 'error))
+ (string->pointer s "ISO-8859-1"))))
+
+ (pass-if "%default-port-conversion-strategy is soft"
+ (let ((s "teĥniko"))
+ (equal? (map (lambda (strategy)
+ (with-fluids ((%default-port-conversion-strategy strategy))
+ (pointer->string (string->pointer s "ISO-8859-1"))))
+ '(substitute escape))
+ (list "te?niko"
+ (format #f "te\\u~4,'0xniko"
+ (char->integer #\ĥ))))))
+
(pass-if "bijection"
(let ((s "hello, world"))
(string=? s (pointer->string (string->pointer s)))))
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 2aec1f0b2..2b161b5ad 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -58,6 +58,34 @@
string))
+
+(with-test-prefix "%default-port-conversion-strategy"
+
+ (pass-if "initial value"
+ (eq? 'substitute (fluid-ref %default-port-conversion-strategy)))
+
+ (pass-if "file port"
+ (let ((strategies '(error substitute escape)))
+ (equal? (map (lambda (s)
+ (with-fluids ((%default-port-conversion-strategy s))
+ (call-with-output-file "/dev/null"
+ (lambda (p)
+ (port-conversion-strategy p)))))
+ strategies)
+ strategies)))
+
+ (pass-if "(set-port-conversion-strategy! #f sym)"
+ (begin
+ (set-port-conversion-strategy! #f 'error)
+ (and (eq? (fluid-ref %default-port-conversion-strategy) 'error)
+ (begin
+ (set-port-conversion-strategy! #f 'substitute)
+ (eq? (fluid-ref %default-port-conversion-strategy)
+ 'substitute)))))
+
+)
+
+
;;;; Normal file ports.
;;; Write out an s-expression, and read it back.