Fix possible deadlock upon `encoding-error' in `open-input-string'.

Partly addresses <http://bugs.gnu.org/11197>.

* libguile/strports.c (scm_mkstrport): Call `scm_port_non_buffer', set
  Z's cell type and stream, and release `scm_i_port_table_mutex' early.
  Reacquire `scm_i_port_table_mutex' once BUF, C_BUF, and STR_LEN are
  initialized.

* test-suite/tests/ports.test ("string ports")["encoding failure leads
  to exception"]: New test.

2 files changed, 39 insertions, 7 deletions

diff --git a/libguile/strports.c b/libguile/strports.c
index ca3a2cf76..14cc93f81 100644
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -288,7 +288,18 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
   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_SET_CELL_TYPE (z, scm_tc16_strport);
+  pt = SCM_PTAB_ENTRY (z);
+
+  /* Make PT initially empty, and release the port-table mutex
+     immediately.  This is so that if one of the function calls below
+     raises an exception, a pre-unwind catch handler can still create
+     new ports; for instance, `display-backtrace' needs to be able to
+     allocate a new string port.  See <http://bugs.gnu.org/11197>.  */
+  scm_port_non_buffer (pt);
+  SCM_SETSTREAM (z, SCM_UNPACK (scm_null_bytevector));
+
+  scm_dynwind_end ();
 
   if (scm_is_false (str))
     {
@@ -296,10 +307,6 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
       str_len = INITIAL_BUFFER_SIZE;
       buf = scm_c_make_bytevector (str_len);
       c_buf = (char *) SCM_BYTEVECTOR_CONTENTS (buf);
-
-      /* Reset `read_buf_size'.  It will contain the actual number of
-	 bytes written to PT.  */
-      pt->read_buf_size = 0;
       c_pos = 0;
     }
   else
@@ -318,12 +325,21 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
       free (copy);
 
       c_pos = scm_to_unsigned_integer (pos, 0, str_len);
-      pt->read_buf_size = str_len;
     }
 
+  /* Now, finish up the port.  */
+  scm_i_pthread_mutex_lock (&scm_i_port_table_mutex);
+
   SCM_SETSTREAM (z, SCM_UNPACK (buf));
   SCM_SET_CELL_TYPE (z, scm_tc16_strport | modes);
 
+  if (scm_is_false (str))
+    /* Reset `read_buf_size'.  It will contain the actual number of
+       bytes written to PT.  */
+    pt->read_buf_size = 0;
+  else
+    pt->read_buf_size = str_len;
+
   pt->write_buf = pt->read_buf = (unsigned char *) c_buf;
   pt->read_pos = pt->write_pos = pt->read_buf + c_pos;
   pt->write_buf_size = str_len;
@@ -331,7 +347,7 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
 
   pt->rw_random = 1;
 
-  scm_dynwind_end ();
+  scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
 
   /* Ensure WRITE_POS is writable.  */
   if ((modes & SCM_WRTNG) && pt->write_pos == pt->write_end)
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 7728e2587..613d2693f 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -413,6 +413,22 @@
     (pass-if "output check"
 	     (string=? text result)))
 
+  (pass-if "encoding failure leads to exception"
+    ;; Prior to 2.0.6, this would trigger a deadlock in `scm_mkstrport'.
+    ;; See the discussion at <http://bugs.gnu.org/11197>, for details.
+    (catch 'encoding-error
+      (lambda ()
+        (with-fluids ((%default-port-encoding "ISO-8859-1"))
+          (let ((p (open-input-string "λ")))      ; raise an exception
+            #f)))
+      (lambda (key . rest)
+        #t)
+      (lambda (key . rest)
+        ;; At this point, the port-table mutex used to be still held,
+        ;; hence the deadlock.  This situation would occur when trying
+        ;; to print a backtrace, for instance.
+        (input-port? (open-input-string "foo")))))
+
   (pass-if "%default-port-encoding is honored"
     (let ((encodings '("UTF-8" "UTF-16" "ISO-8859-1" "ISO-8859-3")))
       (equal? (map (lambda (e)