diff options
author | Ludovic Courtès <ludo@gnu.org> | 2012-05-29 23:39:05 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2012-05-31 00:50:36 +0200 |
commit | b22e94db7c91d7661204e33f3bc2bfead002c9b7 (patch) | |
tree | 107acc1190f8ac32e8e12ccd3cff8dd0a0b9035c | |
parent | 478848cb706b23bcc4c2afe9a4ad33c595bc33f6 (diff) | |
download | guile-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.texi | 15 | ||||
-rw-r--r-- | libguile/foreign.c | 4 | ||||
-rw-r--r-- | libguile/ports.c | 167 | ||||
-rw-r--r-- | libguile/ports.h | 9 | ||||
-rw-r--r-- | libguile/strings.c | 6 | ||||
-rw-r--r-- | test-suite/test-suite/lib.scm | 2 | ||||
-rw-r--r-- | test-suite/tests/foreign.test | 17 | ||||
-rw-r--r-- | test-suite/tests/ports.test | 28 |
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. |