[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.11-27-ga43fa1b

[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=a43fa1b70688b09a9eecac3c2ce8e9adea63bab6

The branch, stable-2.0 has been updated
       via  a43fa1b70688b09a9eecac3c2ce8e9adea63bab6 (commit)
       via  a41b07a34f7309dccb2140ed924d7cd1c63268f9 (commit)
       via  eb6ac6efcdb6fe72fdecb4aa7161e86d0e1d3282 (commit)
      from  1baa2159307c34683e8ede54f38f65010fc594b0 (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 a43fa1b70688b09a9eecac3c2ce8e9adea63bab6
Author: Ludovic Courtès <address@hidden>
Date:   Wed May 28 23:06:45 2014 +0200

    Slightly simplify 'scm_open_process'.
    
    * libguile/posix.c (scm_open_process): Call 'scm_fdes_to_port' with the
      '0' flag, and remove 'scm_setvbuf' calls.

commit a41b07a34f7309dccb2140ed924d7cd1c63268f9
Author: Ludovic Courtès <address@hidden>
Date:   Wed May 28 23:00:20 2014 +0200

    rdelim: Speed up 'read-string' (aka. 'get-string-all'.)
    
    This yields a 20% improvement on the "read-string" benchmark.
    
    * module/ice-9/rdelim.scm (read-string): Rewrite as a 'case-lambda',
      with a tight loop around 'read-char', and without using
      'read-string!'.
    * test-suite/tests/rdelim.test ("read-string")["longer than 100 chars,
      with limit"]: New test.
    * benchmark-suite/benchmarks/ports.bm ("rdelim")["read-string"]: New
      benchmark.

commit eb6ac6efcdb6fe72fdecb4aa7161e86d0e1d3282
Author: Ludovic Courtès <address@hidden>
Date:   Wed May 28 22:19:16 2014 +0200

    tests: Add test for <http://bugs.gnu.org/17466>.
    
    * test-suite/tests/r6rs-ports.test ("7.2.8 Binary
      Input")("http://bugs.gnu.org/17466";): New test.

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

Summary of changes:
 benchmark-suite/benchmarks/ports.bm |   10 ++++++-
 libguile/posix.c                    |   12 ++++-----
 module/ice-9/rdelim.scm             |   44 +++++++++++++++++++----------------
 test-suite/tests/r6rs-ports.test    |   20 ++++++++++++++++
 test-suite/tests/rdelim.test        |   10 ++++++-
 5 files changed, 65 insertions(+), 31 deletions(-)

diff --git a/benchmark-suite/benchmarks/ports.bm 
b/benchmark-suite/benchmarks/ports.bm
index 630ece2..f4da260 100644
--- a/benchmark-suite/benchmarks/ports.bm
+++ b/benchmark-suite/benchmarks/ports.bm
@@ -1,6 +1,6 @@
 ;;; ports.bm --- Port I/O.         -*- mode: scheme; coding: utf-8; -*-
 ;;;
-;;; Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc.
+;;; Copyright (C) 2010, 2011, 2012, 2014 Free Software Foundation, Inc.
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public License
@@ -89,4 +89,10 @@
     (benchmark "read-line" 1000
                (let ((port (with-fluids ((%default-port-encoding "UTF-8"))
                              (open-input-string str))))
-                 (sequence (read-line port) 1000)))))
+                 (sequence (read-line port) 1000))))
+
+  (let ((str (large-string "Hello, world.\n")))
+    (benchmark "read-string" 200
+               (let ((port (with-fluids ((%default-port-encoding "UTF-8"))
+                             (open-input-string str))))
+                 (read-string port)))))
diff --git a/libguile/posix.c b/libguile/posix.c
index 6a940e4..1dcb5ac 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -1345,23 +1345,21 @@ scm_open_process (SCM mode, SCM prog, SCM args)
       SCM read_port = SCM_BOOL_F, write_port = SCM_BOOL_F;
 
       /* There is no sense in catching errors on close().  */
-      if (reading) 
+      if (reading)
         {
           close (c2p[1]);
-          read_port = scm_fdes_to_port (c2p[0], "r", sym_read_pipe);
-          scm_setvbuf (read_port, scm_from_int (_IONBF), SCM_UNDEFINED);
+          read_port = scm_fdes_to_port (c2p[0], "r0", sym_read_pipe);
         }
       if (writing)
         {
           close (p2c[0]);
-          write_port = scm_fdes_to_port (p2c[1], "w", sym_write_pipe);
-          scm_setvbuf (write_port, scm_from_int (_IONBF), SCM_UNDEFINED);
+          write_port = scm_fdes_to_port (p2c[1], "w0", sym_write_pipe);
         }
-      
+
       return scm_values
         (scm_list_3 (read_port, write_port, scm_from_int (pid)));
     }
-  
+
   /* The child.  */
   if (reading)
     close (c2p[0]);
diff --git a/module/ice-9/rdelim.scm b/module/ice-9/rdelim.scm
index 32908cc..a406f4e 100644
--- a/module/ice-9/rdelim.scm
+++ b/module/ice-9/rdelim.scm
@@ -1,7 +1,8 @@
 ;;; installed-scm-file
 
-;;;; Copyright (C) 1997, 1999, 2000, 2001, 2006, 2010, 2013 Free Software 
Foundation, Inc.
-;;;; 
+;;;; Copyright (C) 1997, 1999, 2000, 2001, 2006, 2010, 2013,
+;;;;   2014 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
 ;;;; License as published by the Free Software Foundation; either
@@ -148,26 +149,29 @@ left in the port."
                 (lp (1+ n)))))
         (- n start))))
 
-(define* (read-string #:optional (port (current-input-port)) (count #f))
-  "Read all of the characters out of PORT and return them as a string.
+(define* read-string
+  (case-lambda*
+   "Read all of the characters out of PORT and return them as a string.
 If the COUNT argument is present, treat it as a limit to the number of
 characters to read.  By default, there is no limit."
-  (check-arg (or (not count) (index? count)) "bad count" count)
-  (let loop ((substrings '())
-             (total-chars 0)
-             (buf-size 100))           ; doubled each time through.
-    (let* ((buf (make-string (if count
-                                 (min buf-size (- count total-chars))
-                                 buf-size)))
-           (nchars (read-string! buf port))
-           (new-total (+ total-chars nchars)))
-      (cond
-       ((= nchars buf-size)
-        ;; buffer filled.
-        (loop (cons buf substrings) new-total (* buf-size 2)))
-       (else
-        (string-concatenate-reverse
-         (cons (substring buf 0 nchars) substrings)))))))
+   ((#:optional (port (current-input-port)))
+    ;; Fast path.
+    ;; This creates more garbage than using 'string-set!' as in
+    ;; 'read-string!', but currently that is faster nonetheless.
+    (let loop ((chars '()))
+      (let ((char (read-char port)))
+        (if (eof-object? char)
+            (list->string (reverse! chars))
+            (loop (cons char chars))))))
+   ((port count)
+    ;; Slower path.
+    (let loop ((chars '())
+               (total 0))
+      (let ((char (read-char port)))
+        (if (or (eof-object? char) (>= total count))
+            (list->string (reverse chars))
+            (loop (cons char chars) (+ 1 total))))))))
+
 
 ;;; read-line [PORT [HANDLE-DELIM]] reads a newline-terminated string
 ;;; from PORT.  The return value depends on the value of HANDLE-DELIM,
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
index 07c9f44..dba8036 100644
--- a/test-suite/tests/r6rs-ports.test
+++ b/test-suite/tests/r6rs-ports.test
@@ -137,6 +137,26 @@
       (close-port port)
       (get-bytevector-n port 3)))
 
+  (let ((expected (make-bytevector 20 (char->integer #\a))))
+    (pass-if-equal "http://bugs.gnu.org/17466";
+        ;; <http://bugs.gnu.org/17466> is about a memory corruption
+        ;; whereas bytevector shrunk in 'get-bytevector-n' would keep
+        ;; referring to the previous (larger) bytevector.
+        expected
+      (let loop ((count 50))
+        (if (zero? count)
+            expected
+            (let ((bv (call-with-input-string "aaaaaaaaaaaaaaaaaaaa"
+                        (lambda (port)
+                          (get-bytevector-n port 4096)))))
+              ;; Cause the 4 KiB bytevector initially created by
+              ;; 'get-bytevector-n' to be reclaimed.
+              (make-bytevector 4096)
+
+              (if (equal? bv expected)
+                  (loop (- count 1))
+                  bv))))))
+
   (pass-if "get-bytevector-n! [short]"
     (let* ((port (open-input-string "GNU Guile"))
            (bv   (make-bytevector 4))
diff --git a/test-suite/tests/rdelim.test b/test-suite/tests/rdelim.test
index 5cfe646..9083b7f 100644
--- a/test-suite/tests/rdelim.test
+++ b/test-suite/tests/rdelim.test
@@ -1,7 +1,7 @@
 ;;;; rdelim.test --- Delimited I/O.      -*- mode: scheme; coding: utf-8; -*-
 ;;;; Ludovic Courtès <address@hidden>
 ;;;;
-;;;;   Copyright (C) 2011, 2013 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2011, 2013, 2014 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
@@ -209,7 +209,13 @@
       (let* ((s (string-concatenate (make-list 20 "hello, world!")))
              (p (open-input-string s)))
         (and (string=? (read-string p) s)
-             (string=? (read-string p) "")))))
+             (string=? (read-string p) ""))))
+
+    (pass-if-equal "longer than 100 chars, with limit"
+        "hello, world!"
+      (let* ((s (string-concatenate (make-list 20 "hello, world!")))
+             (p (open-input-string s)))
+        (read-string p 13))))
 
   (with-test-prefix "read-string!"
 


hooks/post-receive
-- 
GNU Guile