[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-44-g5a35d42

[Andy Wingo]

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=5a35d42aa5be26f1048fceea9acfa21bc9f6bc3e

The branch, stable-2.0 has been updated
       via  5a35d42aa5be26f1048fceea9acfa21bc9f6bc3e (commit)
      from  84f5a8251710c7d2a01590aa083d9dd409a56279 (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 5a35d42aa5be26f1048fceea9acfa21bc9f6bc3e
Author: Andy Wingo <address@hidden>
Date:   Tue Jan 22 10:12:59 2013 +0100

    add read-string and read-string! to (ice-9 rdelim)
    
    * module/ice-9/rdelim.scm (read-string!, read-string): New functions.
    * test-suite/tests/rdelim.test: Add tests.
    * doc/ref/api-io.texi: Add docs.
    
    * module/ice-9/iconv.scm:
    * module/rnrs/io/ports.scm:
    * module/web/uri.scm: Use the new functions.

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

Summary of changes:
 doc/ref/api-io.texi          |   27 ++++++++++++++++++++
 module/ice-9/iconv.scm       |    4 +-
 module/ice-9/rdelim.scm      |   57 +++++++++++++++++++++++++++++++++++++++++-
 module/rnrs/io/ports.scm     |    4 +-
 module/web/uri.scm           |    4 +-
 test-suite/tests/rdelim.test |   57 ++++++++++++++++++++++++++++++++++++++++-
 6 files changed, 144 insertions(+), 9 deletions(-)

diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi
index de3684c..11ae580 100644
--- a/doc/ref/api-io.texi
+++ b/doc/ref/api-io.texi
@@ -577,6 +577,33 @@ used.  This function is equivalent to:
 @end lisp
 @end deffn
 
+In the past, Guile did not have a procedure that would just read out all
+of the characters from a port.  As a workaround, many people just called
address@hidden with no delimiters, knowing that would produce the
+behavior they wanted.  This prompted Guile developers to add some
+routines that would read all characters from a port.  So it is that
address@hidden(ice-9 rdelim)} is also the home for procedures that can reading
+undelimited text:
+
address@hidden {Scheme Procedure} read-string [port] [count]
+Read all of the characters out of @var{port} and return them as a
+string.  If the @var{count} is present, treat it as a limit to the
+number of characters to read.
+
+By default, read from the current input port, with no size limit on the
+result.  This procedure always returns a string, even if no characters
+were read.
address@hidden deffn
+
address@hidden {Scheme Procedure} read-string! buf [port] [start] [end]
+Fill @var{buf} with characters read from @var{port}, defaulting to the
+current input port.  Return the number of characters read.
+
+If @var{start} or @var{end} are specified, store data only into the
+substring of @var{str} bounded by @var{start} and @var{end} (which
+default to the beginning and end of the string, respectively).
address@hidden deffn
+
 Some of the aforementioned I/O functions rely on the following C
 primitives.  These will mainly be of interest to people hacking Guile
 internals.
diff --git a/module/ice-9/iconv.scm b/module/ice-9/iconv.scm
index 88af90d..125dad8 100644
--- a/module/ice-9/iconv.scm
+++ b/module/ice-9/iconv.scm
@@ -21,7 +21,7 @@
 (define-module (ice-9 iconv)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 binary-ports)
-  #:use-module ((ice-9 rdelim) #:select (read-delimited))
+  #:use-module ((ice-9 rdelim) #:select (read-string))
   #:export (string->bytevector
             bytevector->string
             call-with-encoded-output-string))
@@ -88,7 +88,7 @@ naming a character encoding, like \"utf-8\"."
         (set-port-encoding! p encoding)
         (if conversion-strategy
             (set-port-conversion-strategy! p conversion-strategy))
-        (let ((res (read-delimited "" p)))
+        (let ((res (read-string p)))
           (close-port p)
           (if (eof-object? res)
               ""
diff --git a/module/ice-9/rdelim.scm b/module/ice-9/rdelim.scm
index c6ab2ba..aace481 100644
--- a/module/ice-9/rdelim.scm
+++ b/module/ice-9/rdelim.scm
@@ -1,6 +1,6 @@
 ;;; installed-scm-file
 
-;;;; Copyright (C) 1997, 1999, 2000, 2001, 2006, 2010 Free Software 
Foundation, Inc.
+;;;; Copyright (C) 1997, 1999, 2000, 2001, 2006, 2010, 2013 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
@@ -26,6 +26,8 @@
             read-line!
             read-delimited
             read-delimited!
+            read-string
+            read-string!
             %read-delimited!
             %read-line
             write-line))
@@ -114,6 +116,59 @@
             (else (error "unexpected handle-delim value: "
                          handle-delim)))))))))
 
+(define-syntax-rule (check-arg exp message arg ...)
+  (unless exp
+    (error message arg ...)))
+
+(define (index? n)
+  (and (integer? n) (exact? n) (>= n 0)))
+
+(define* (read-string! buf #:optional
+                       (port (current-input-port))
+                       (start 0) (end (string-length buf)))
+  "Read all of the characters out of PORT and write them to BUF.
+Returns the number of characters read.
+
+This function only reads out characters from PORT if it will be able to
+write them to BUF.  That is to say, if BUF is smaller than the number of
+available characters, then BUF will be filled, and characters will be
+left in the port."
+  (check-arg (string? buf) "not a string" buf)
+  (check-arg (index? start) "bad index" start)
+  (check-arg (index? end) "bad index" end)
+  (check-arg (<= start end) "start beyond end" start end)
+  (check-arg (<= end (string-length buf)) "end beyond string length" end)
+  (let lp ((n start))
+    (if (< n end)
+        (let ((c (read-char port)))
+          (if (eof-object? c)
+              (- n start)
+              (begin
+                (string-set! buf n c)
+                (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.
+If the COUNT 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)))))))
+
 ;;; read-line [PORT [HANDLE-DELIM]] reads a newline-terminated string
 ;;; from PORT.  The return value depends on the value of HANDLE-DELIM,
 ;;; which may be one of the symbols `trim', `concat', `peek' and
diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm
index 7c17b0c..c1484cb 100644
--- a/module/rnrs/io/ports.scm
+++ b/module/rnrs/io/ports.scm
@@ -1,6 +1,6 @@
 ;;;; ports.scm --- R6RS port API                    -*- coding: utf-8 -*-
 
-;;;;   Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2009, 2010, 2011, 2013 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
@@ -461,7 +461,7 @@ return the characters accumulated in that port."
   (with-textual-input-conditions port (read-line port 'trim)))
 
 (define (get-string-all port)
-  (with-textual-input-conditions port (read-delimited "" port 'concat)))
+  (with-textual-input-conditions port (read-string port)))
 
 (define (get-string-n port count)
   "Read up to @var{count} characters from @var{port}.
diff --git a/module/web/uri.scm b/module/web/uri.scm
index b688ea8..25406b3 100644
--- a/module/web/uri.scm
+++ b/module/web/uri.scm
@@ -1,6 +1,6 @@
 ;;;; (web uri) --- URI manipulation tools
 ;;;;
-;;;; Copyright (C) 1997,2001,2002,2010,2011,2012 Free Software Foundation, Inc.
+;;;; Copyright (C) 1997,2001,2002,2010,2011,2012,2013 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
@@ -286,7 +286,7 @@ serialization."
       (utf8->string bv)
       (let ((p (open-bytevector-input-port bv)))
         (set-port-encoding! p encoding)
-        (let ((res (read-delimited "" p)))
+        (let ((res (read-string p)))
           (close-port p)
           res))))
 
diff --git a/test-suite/tests/rdelim.test b/test-suite/tests/rdelim.test
index e61fc92..5cfe646 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 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2011, 2013 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
@@ -189,7 +189,60 @@
 
     (pass-if "eof, split"
       (eof-object? (read-delimited! ":" (make-string 7)
-                                    (open-input-string ""))))))
+                                    (open-input-string "")))))
+
+  (with-test-prefix "read-string"
+
+    (pass-if "short string"
+      (let* ((s "hello, world!")
+             (p (open-input-string s)))
+        (and (string=? (read-string p) s)
+             (string=? (read-string p) ""))))
+
+    (pass-if "100 chars"
+      (let* ((s (make-string 100 #\space))
+             (p (open-input-string s)))
+        (and (string=? (read-string p) s)
+             (string=? (read-string p) ""))))
+
+    (pass-if "longer than 100 chars"
+      (let* ((s (string-concatenate (make-list 20 "hello, world!")))
+             (p (open-input-string s)))
+        (and (string=? (read-string p) s)
+             (string=? (read-string p) "")))))
+
+  (with-test-prefix "read-string!"
+
+    (pass-if "buf smaller"
+      (let* ((s "hello, world!")
+             (len (1- (string-length s)))
+             (buf (make-string len #\.))
+             (p (open-input-string s)))
+        (and (= (read-string! buf p) len)
+             (string=? buf (substring s 0 len))
+             (= (read-string! buf p) 1)
+             (string=? (substring buf 0 1) (substring s len)))))
+
+    (pass-if "buf right size"
+      (let* ((s "hello, world!")
+             (len (string-length s))
+             (buf (make-string len #\.))
+             (p (open-input-string s)))
+        (and (= (read-string! buf p) len)
+             (string=? buf (substring s 0 len))
+             (= (read-string! buf p) 0)
+             (string=? buf (substring s 0 len)))))
+
+    (pass-if "buf bigger"
+      (let* ((s "hello, world!")
+             (len (string-length s))
+             (buf (make-string (1+ len) #\.))
+             (p (open-input-string s)))
+        (and (= (read-string! buf p) len)
+             (string=? (substring buf 0 len) s)
+             (= (read-string! buf p) 0)
+             (string=? (substring buf 0 len) s)
+             (string=? (substring buf len) "."))))))
 
 ;;; Local Variables:
 ;;; eval: (put 'with-test-prefix 'scheme-indent-function 1)


hooks/post-receive
-- 
GNU Guile