[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.5-174-g03fcf93

[Ludovic Courtès]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=03fcf93bff9f02a3d12ab86be4e67b996310aad4

The branch, stable-2.0 has been updated
       via  03fcf93bff9f02a3d12ab86be4e67b996310aad4 (commit)
       via  ecb48dccbac6b8fdd969f50a23351ef7f4b91ce5 (commit)
       via  2cb363622d03b18402d6ee15c8c87d8fee9bfc32 (commit)
      from  f3b312a19d70293d7a3407fc4ef479183edd7cca (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 03fcf93bff9f02a3d12ab86be4e67b996310aad4
Author: Ludovic Courtès <address@hidden>
Date:   Wed Jun 20 22:56:11 2012 +0200

    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.

commit ecb48dccbac6b8fdd969f50a23351ef7f4b91ce5
Author: Ludovic Courtès <address@hidden>
Date:   Wed Jun 20 15:49:42 2012 +0200

    Make SRFI-6 string ports Unicode-capable.
    
    Partly addresses <http://bugs.gnu.org/11197>.
    Reported by Klaus Stehle <address@hidden>.
    
    * module/srfi/srfi-6.scm (open-input-string, open-output-string): New
      procedures.
    
    * test-suite/tests/srfi-6.test ("open-input-string")["read-char,
      Unicode"]: New test.
      ("open-output-string")["λ"]: New test.

commit 2cb363622d03b18402d6ee15c8c87d8fee9bfc32
Author: Ludovic Courtès <address@hidden>
Date:   Wed Jun 20 15:44:29 2012 +0200

    Update `THANKS'.

-----------------------------------------------------------------------

Summary of changes:
 THANKS                       |    1 +
 libguile/strports.c          |   30 +++++++++++++++++++++++-------
 module/srfi/srfi-6.scm       |   18 ++++++++++++++----
 test-suite/tests/ports.test  |   16 ++++++++++++++++
 test-suite/tests/srfi-6.test |   26 +++++++++++++++++++++-----
 5 files changed, 75 insertions(+), 16 deletions(-)

diff --git a/THANKS b/THANKS
index bdf11ee..1b61a81 100644
--- a/THANKS
+++ b/THANKS
@@ -101,6 +101,7 @@ For fixes or providing information which led to a fix:
          Daniel Llorens del Río
            Jeff Long
          Marco Maggi
+      Bogdan A. Marinescu
         Gregory Marton
       Kjetil S. Matheussen
         Antoine Mathys
diff --git a/libguile/strports.c b/libguile/strports.c
index ca3a2cf..14cc93f 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/module/srfi/srfi-6.scm b/module/srfi/srfi-6.scm
index 098b586..7b8bcb1 100644
--- a/module/srfi/srfi-6.scm
+++ b/module/srfi/srfi-6.scm
@@ -1,6 +1,6 @@
 ;;; srfi-6.scm --- Basic String Ports
 
-;;     Copyright (C) 2001, 2002, 2003, 2006 Free Software Foundation, Inc.
+;;     Copyright (C) 2001, 2002, 2003, 2006, 2012 Free Software Foundation, 
Inc.
 ;;
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -23,10 +23,20 @@
 ;;; Code:
 
 (define-module (srfi srfi-6)
-  #:re-export (open-input-string open-output-string get-output-string))
+  #:replace (open-input-string open-output-string)
+  #:re-export (get-output-string))
 
-;; Currently, guile provides these functions by default, so no action
-;; is needed, and this file is just a placeholder.
+;; SRFI-6 says nothing about encodings, and assumes that any character
+;; or string can be written to a string port.  Thus, make all SRFI-6
+;; string ports Unicode capable.  See <http://bugs.gnu.org/11197>.
+
+(define (open-input-string s)
+  (with-fluids ((%default-port-encoding "UTF-8"))
+    ((@ (guile) open-input-string) s)))
+
+(define (open-output-string)
+  (with-fluids ((%default-port-encoding "UTF-8"))
+    ((@ (guile) open-output-string))))
 
 (cond-expand-provide (current-module) '(srfi-6))
 
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 7728e25..613d269 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)
diff --git a/test-suite/tests/srfi-6.test b/test-suite/tests/srfi-6.test
index 68fc70d..bd9167c 100644
--- a/test-suite/tests/srfi-6.test
+++ b/test-suite/tests/srfi-6.test
@@ -1,6 +1,6 @@
 ;;;; srfi-6.test --- test suite for SRFI-6   -*- scheme -*-
 ;;;;
-;;;;   Copyright (C) 2003, 2006 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2003, 2006, 2012 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -37,13 +37,21 @@
           (char=? #\y (read-char port))
           (char=? #\z (read-char port))
           (eof-object? (read-char port)))))
-  
+
+  (pass-if "read-char, Unicode"
+    ;; String ports should always be Unicode-capable.
+    ;; See <http://bugs.gnu.org/11197>.
+    (with-fluids ((%default-port-encoding "ISO-8859-1"))
+      (let ((port (open-input-string "λμ")))
+        (and (char=? #\λ (read-char port))
+             (char=? #\μ (read-char port))))))
+
   (with-test-prefix "unread-char"
     
     (pass-if "one char"
       (let ((port (open-input-string "")))
-       (unread-char #\x port)
-       (and (char=? #\x (read-char port))
+        (unread-char #\x port)
+        (and (char=? #\x (read-char port))
             (eof-object? (read-char port)))))
     
     (pass-if "after eof"
@@ -75,7 +83,15 @@
     (let ((port (open-output-string)))
       (display "xyz" port)
       (string=? "xyz" (get-output-string port))))
-  
+
+  (pass-if "λ"
+    ;; Writing to an output string should always work.
+    ;; See <http://bugs.gnu.org/11197>.
+    (with-fluids ((%default-port-encoding "ISO-8859-1"))
+      (let ((port (open-output-string)))
+        (display "λ" port)
+        (string=? "λ" (get-output-string port)))))
+
   (pass-if "seek"
     (let ((port (open-output-string)))
       (display "abcdef" port)


hooks/post-receive
-- 
GNU Guile