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'.

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

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 ();
 

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.  */
+/* A fluid specifying the default conversion handler for newly created
-SCM_GLOBAL_VARIABLE (scm_conversion_strategy, "%port-conversion-strategy");
+   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;
 
-scm_t_string_failed_conversion_handler
+/* The possible conversion strategies.  */
-scm_i_get_conversion_strategy (SCM port)
+SCM_SYMBOL (sym_error, "error");
-{
+SCM_SYMBOL (sym_substitute, "substitute");
-  SCM encoding;
+SCM_SYMBOL (sym_escape, "escape");
 
-  if (scm_is_false (port))
+/* Return the default failed encoding conversion policy for new created
-    {
+   ports.  */
-      if (!scm_conversion_strategy_init
+scm_t_string_failed_conversion_handler
-	  || !scm_is_fluid (SCM_VARIABLE_REF (scm_conversion_strategy)))
+scm_i_default_port_conversion_handler (void)
-	return SCM_FAILED_CONVERSION_QUESTION_MARK;
+{
-      else
+  scm_t_string_failed_conversion_handler handler;
-	{
+
-	  encoding = scm_fluid_ref (SCM_VARIABLE_REF (scm_conversion_strategy));
+  if (!scm_conversion_strategy_init
-	  if (scm_is_false (encoding))
+      || !scm_is_fluid (SCM_VARIABLE_REF (default_conversion_strategy_var)))
-	    return SCM_FAILED_CONVERSION_QUESTION_MARK;
+    handler = SCM_FAILED_CONVERSION_QUESTION_MARK;
-	  else 
-	    return (scm_t_string_failed_conversion_handler) scm_to_int (encoding);
-	}
-    }
   else
     {
-      scm_t_port *pt;
+      SCM fluid, value;
-      pt = SCM_PTAB_ENTRY (port);
+
-      return pt->ilseq_handler;
+      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_i_set_default_port_conversion_handler (scm_t_string_failed_conversion_handler
-				 scm_t_string_failed_conversion_handler handler)
+					   handler)
 {
   SCM strategy;
-  scm_t_port *pt;
 
-  strategy = scm_from_int ((int) handler);
+  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);
 
-  if (scm_is_false (port))
+  switch (handler)
     {
-      /* Set the default encoding for future ports.  */
+    case SCM_FAILED_CONVERSION_ERROR:
-      if (!scm_conversion_strategy_init
+      strategy = sym_error;
-	  || !scm_is_fluid (SCM_VARIABLE_REF (scm_conversion_strategy)))
+      break;
-	scm_misc_error (NULL, "tried to set conversion strategy fluid before it is initialized",
+
-                       SCM_EOL);
+    case SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE:
-      scm_fluid_set_x (SCM_VARIABLE_REF (scm_conversion_strategy), strategy);
+      strategy = sym_escape;
-    }
+      break;
-  else
+
-    {
+    case SCM_FAILED_CONVERSION_QUESTION_MARK:
-      /* Set the character encoding for this port.  */
+      strategy = sym_substitute;
-      pt = SCM_PTAB_ENTRY (port);
+      break;
-      pt->ilseq_handler = handler;
+
+    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))
-
+    h = scm_i_default_port_conversion_handler ();
-  if (!scm_is_false (port))
+  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_t_string_failed_conversion_handler handler;
-  SCM qm;
-  SCM esc;
 
-  if (!scm_is_false (port))
+  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));
+
+  if (scm_is_false (port))
+    scm_i_set_default_port_conversion_handler (handler);
+  else
     {
       SCM_VALIDATE_OPPORT (1, port);
+      SCM_PTAB_ENTRY (port)->ilseq_handler = handler;
     }
 
-  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;
-    }
-
-  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;
-    }
-
-  esc = scm_from_latin1_symbol ("escape");
-  if (scm_is_true (scm_eqv_p (sym, esc)))
-    {
-      scm_i_set_conversion_strategy_x (port,
-                                       SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE);
-      return SCM_UNSPECIFIED;
-    }
-
-  SCM_MISC_ERROR ("unknown conversion behavior ~s", scm_list_1 (sym));
-
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -2577,9 +2585,8 @@ scm_init_ports ()
                     scm_make_fluid_with_default (SCM_BOOL_F));
   scm_port_encoding_init = 1;
 
-  SCM_VARIABLE_SET (scm_conversion_strategy,
+  SCM_VARIABLE_SET (default_conversion_strategy_var,
-                    scm_make_fluid_with_default
+                    scm_make_fluid_with_default (sym_substitute));
-                    (scm_from_int ((int) SCM_FAILED_CONVERSION_QUESTION_MARK)));
   scm_conversion_strategy_init = 1;
 
   /* These bindings are used when boot-9 turns `current-input-port' et

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 scm_t_string_failed_conversion_handler
-SCM_INTERNAL void scm_i_set_conversion_strategy_x (SCM port, 
+scm_i_default_port_conversion_handler (void);
-						   scm_t_string_failed_conversion_handler h);
+/* 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 *);

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
@@ -1804,7 +1804,7 @@ scm_to_locale_stringn (SCM str, size_t *lenp)
 {
   return scm_to_stringn (str, lenp,
                          locale_charset (),
-                         scm_i_get_conversion_strategy (SCM_BOOL_F));
+                         scm_i_default_port_conversion_handler ());
 }
 
 char *

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

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)))))

test-suite/tests/ports.test

@@ -57,6 +57,34 @@
     (close-port port)
     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.