[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.11-27-ga43fa
From: |
Ludovic Courtès |
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.11-27-ga43fa1b |
Date: |
Wed, 28 May 2014 21:07:44 +0000 |
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
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.11-27-ga43fa1b,
Ludovic Courtès <=