Change `scm_encoding_error' to pass the port and faulty character.

* libguile/strings.c (scm_encoding_error): Remove the `from', `to', and
  `string_or_bv' parameters; add `port' and `chr'.
  (scm_to_stringn): Update accordingly.

* libguile/strings.h (scm_encoding_error): Update accordingly.

* libguile/ports.c (scm_ungetc): Update accordingly.

* libguile/print.c (iprin1, scm_write_char): Update accordingly.

* test-suite/tests/encoding-escapes.test ("display output
  errors")["ultima", "Rashomon"]: Check the arguments of
  `encoding-error'.
  ["tekniko"]: New test.

* test-suite/tests/ports.test ("string ports")["wrong encoding"]: Adjust
  to new `encoding-error' arguments.

libguile/ports.c

@@ -1571,15 +1571,9 @@ scm_ungetc (scm_t_wchar c, SCM port)
 				 result_buf, &len);
 
   if (SCM_UNLIKELY (result == NULL || len == 0))
-    {
-      SCM chr;
-
-      chr = scm_integer_to_char (scm_from_uint32 (c));
     scm_encoding_error (FUNC_NAME, errno,
 			"conversion to port encoding failed",
-			  "UTF-32", encoding,
-			  scm_string (scm_list_1 (chr)));
-    }
+			SCM_BOOL_F, SCM_MAKE_CHAR (c));
 
   for (i = len - 1; i >= 0; i--)
     scm_unget_byte (result[i], port);

libguile/print.c

@@ -484,8 +484,7 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
 				      scm_i_get_conversion_strategy (port)))
 		scm_encoding_error (__func__, errno,
 				    "cannot convert to output locale",
-				    "UTF-32", scm_i_get_port_encoding (port),
-				    scm_string (scm_list_1 (exp)));
+				    port, exp);
 	    }
 	}
       else if (SCM_IFLAGP (exp)
@@ -570,11 +569,9 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
 					len, port,
 					scm_i_get_conversion_strategy (port));
 	      if (SCM_UNLIKELY (printed < len))
-		/* FIXME: Provide the error location.  */
 		scm_encoding_error (__func__, errno,
 				    "cannot convert to output locale",
-				    "UTF-32", scm_i_get_port_encoding (port),
-				    exp);
+				    port, scm_c_string_ref (exp, printed));
 	    }
 
           scm_remember_upto_here_1 (exp);
@@ -1388,8 +1385,7 @@ SCM_DEFINE (scm_write_char, "write-char", 1, 1, 0,
 			  scm_i_get_conversion_strategy (port)))
     scm_encoding_error (__func__, errno,
 			"cannot convert to output locale",
-			"UTF-32", scm_i_get_port_encoding (port),
-			scm_string (scm_list_1 (chr)));
+			port, chr);
 
   return SCM_UNSPECIFIED;
 }

libguile/strings.c

@@ -1412,21 +1412,17 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1,
 SCM_SYMBOL (scm_encoding_error_key, "encoding-error");
 SCM_SYMBOL (scm_decoding_error_key, "decoding-error");
 
+/* Raise an exception informing that character CHR could not be written
+   to PORT in its current encoding.  */
 void
 scm_encoding_error (const char *subr, int err, const char *message,
-		    const char *from, const char *to, SCM string_or_bv)
+		    SCM port, SCM chr)
 {
-  /* Raise an exception that conveys all the information needed to debug the
-     problem.  Only perform locale conversions that are safe; in particular,
-     don't try to display STRING_OR_BV when it's a string since converting it to
-     the output locale may fail.  */
   scm_throw (scm_encoding_error_key,
 	     scm_list_n (scm_from_locale_string (subr),
 			 scm_from_locale_string (message),
 			 scm_from_int (err),
-			 scm_from_locale_string (from),
-			 scm_from_locale_string (to),
-			 string_or_bv,
+			 port, chr,
 			 SCM_UNDEFINED));
 }
 
@@ -1938,8 +1934,10 @@ scm_to_stringn (SCM str, size_t *lenp, const char *encoding,
 
       if (ret != 0)
         scm_encoding_error (__func__, errno,
-			    "cannot convert to output locale",
-			    "ISO-8859-1", enc, str);
+			    "cannot convert narrow string to output locale",
+			    SCM_BOOL_F,
+			    /* FIXME: Faulty character unknown.  */
+			    SCM_BOOL_F);
     }
   else
     {
@@ -1951,8 +1949,10 @@ scm_to_stringn (SCM str, size_t *lenp, const char *encoding,
                                   NULL, &len);
       if (buf == NULL)
         scm_encoding_error (__func__, errno,
-			    "cannot convert to output locale",
-			    "UTF-32", enc, str);
+			    "cannot convert wide string to output locale",
+			    SCM_BOOL_F,
+			    /* FIXME: Faulty character unknown.  */
+			    SCM_BOOL_F);
     }
   if (handler == SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE)
     {

libguile/strings.h

@@ -211,9 +211,7 @@ SCM_INTERNAL int scm_i_try_narrow_string (SCM str);
 SCM_INTERNAL SCM scm_i_symbol_substring (SCM sym, size_t start, size_t end);
 SCM_INTERNAL scm_t_wchar scm_i_symbol_ref (SCM sym, size_t x);
 SCM_INTERNAL void scm_encoding_error (const char *subr, int err,
-				      const char *message,
-				      const char *from, const char *to,
-				      SCM string_or_bv);
+				      const char *message, SCM port, SCM chr);
 SCM_INTERNAL void scm_decoding_error (const char *subr, int err,
 				      const char *message, SCM port);
 

test-suite/tests/encoding-escapes.test

@@ -67,19 +67,45 @@
 
 (with-test-prefix "display output errors"
 
-  (pass-if-exception "ultima"
-		     exception:encoding-error
+  (pass-if "ultima"
     (let ((pt (open-output-string)))
       (set-port-encoding! pt "ASCII")
       (set-port-conversion-strategy! pt 'error)
-		       (display s1 pt)))
+      (catch 'encoding-error
+        (lambda ()
+          (display s1 pt)
+          #f)
+        (lambda (key subr message errno port chr)
+          (and (eq? port pt)
+               (char=? chr (string-ref s1 0))
+               (string=? (get-output-string pt) ""))))))
 
-  (pass-if-exception "Rashomon"
-		     exception:encoding-error
+  (pass-if "Rashomon"
     (let ((pt (open-output-string)))
       (set-port-encoding! pt "ASCII")
       (set-port-conversion-strategy! pt 'error)
-		       (display s4 pt))))
+      (catch 'encoding-error
+        (lambda ()
+          (display s4 pt)
+          #f)
+        (lambda (key subr message errno port chr)
+          (and (eq? port pt)
+               (char=? chr (string-ref s4 0))
+               (string=? (get-output-string pt) ""))))))
+
+  (pass-if "tekniko"
+    (let ((pt (open-output-string)))
+      (set-port-encoding! pt "ASCII")
+      (set-port-conversion-strategy! pt 'error)
+      (catch 'encoding-error
+        (lambda ()
+          ;; This time encoding should fail on the 3rd character.
+          (display "teĥniko" pt)
+          #f)
+        (lambda (key subr message errno port chr)
+          (and (eq? port pt)
+               (char=? chr #\ĥ)
+               (string=? "te" (get-output-string pt))))))))
 
 ;; Check that questions marks or substitutions appear when the conversion
 ;; mode is substitute

test-suite/tests/ports.test

@@ -420,10 +420,8 @@
             (with-output-to-string
               (lambda ()
                 (display str)))))
-        (lambda (key subr message errno from to faulty-str)
-          (and (eq? faulty-str str)
-               (string=? from "UTF-32")
-               (string=? to "ISO-8859-1")
+        (lambda (key subr message errno port chr)
+          (and (eq? chr #\ĉ)
                (string? (strerror errno)))))))
 
   (pass-if "wrong encoding, substitute"