From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Andy Wingo Newsgroups: gmane.lisp.guile.devel Subject: Re: read-all ? Date: Tue, 22 Jan 2013 10:51:40 +0100 Message-ID: <87k3r5y28j.fsf@pobox.com> References: <87hammwbj0.fsf@pobox.com> <87y5fyt7tn.fsf@gnu.org> <877gn5zih2.fsf@pobox.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1358848318 348 80.91.229.3 (22 Jan 2013 09:51:58 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 22 Jan 2013 09:51:58 +0000 (UTC) Cc: guile-devel@gnu.org To: ludo@gnu.org (Ludovic =?utf-8?Q?Court=C3=A8s?=) Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Tue Jan 22 10:52:15 2013 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1TxaWY-0003iu-RB for guile-devel@m.gmane.org; Tue, 22 Jan 2013 10:52:11 +0100 Original-Received: from localhost ([::1]:54297 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1TxaWH-0004OO-P5 for guile-devel@m.gmane.org; Tue, 22 Jan 2013 04:51:53 -0500 Original-Received: from eggs.gnu.org ([208.118.235.92]:60686) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1TxaWC-0004OC-SV for guile-devel@gnu.org; Tue, 22 Jan 2013 04:51:52 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1TxaW9-0004VI-F3 for guile-devel@gnu.org; Tue, 22 Jan 2013 04:51:48 -0500 Original-Received: from a-pb-sasl-quonix.pobox.com ([208.72.237.25]:45381 helo=sasl.smtp.pobox.com) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1TxaW9-0004UF-4w; Tue, 22 Jan 2013 04:51:45 -0500 Original-Received: from sasl.smtp.pobox.com (unknown [127.0.0.1]) by a-pb-sasl-quonix.pobox.com (Postfix) with ESMTP id 8A0EEA177; Tue, 22 Jan 2013 04:51:44 -0500 (EST) DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=pobox.com; h=from:to:cc :subject:references:date:in-reply-to:message-id:mime-version :content-type; s=sasl; bh=L43oQj0vtsR5ew6+Qy7ORNbOGIQ=; b=HmHOxE gdTEyBNTXo3tEHk4Pdg3sRbgNDrDBEPBYQ3k5zpcRo5XoabrwJeM0mqa18HBZbdr KH5+k+E1EsXQGxpNb7co1Cp+Yi2sF2g/d/C39litCTeqb/0wBQcx9wv8ojllpaiO FOVld1iDYa2iWBWIjkRVBJ3WuGx/aUYN2e8L8= DomainKey-Signature: a=rsa-sha1; c=nofws; d=pobox.com; h=from:to:cc :subject:references:date:in-reply-to:message-id:mime-version :content-type; q=dns; s=sasl; b=F5hTM1V7nmfifRkuXlqQQ/EpA7yUo6yj O+EKVgFelDbppD1u+0a/DvMdAaIuCckqbkwGdYsnebpLiorVN/3aP6nxfTvocbcI oxgIVJOQ2EIHqkUzA8EEiAJF1u5UM2X88+JgitBPD2Kgupfcwc+ffIxw1OL7aEve gUiirqYFn8U= Original-Received: from a-pb-sasl-quonix.pobox.com (unknown [127.0.0.1]) by a-pb-sasl-quonix.pobox.com (Postfix) with ESMTP id 82D58A176; Tue, 22 Jan 2013 04:51:44 -0500 (EST) Original-Received: from badger (unknown [88.160.190.192]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (No client certificate requested) by a-pb-sasl-quonix.pobox.com (Postfix) with ESMTPSA id 6C694A175; Tue, 22 Jan 2013 04:51:43 -0500 (EST) In-Reply-To: <877gn5zih2.fsf@pobox.com> (Andy Wingo's message of "Tue, 22 Jan 2013 10:15:37 +0100") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.2 (gnu/linux) X-Pobox-Relay-ID: 53F1F5E4-6479-11E2-96D2-0A4F0E5B5709-02397024!a-pb-sasl-quonix.pobox.com X-detected-operating-system: by eggs.gnu.org: Solaris 10 X-Received-From: 208.72.237.25 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:15525 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable On Tue 22 Jan 2013 10:15, Andy Wingo writes: > Hi, > > On Sat 12 Jan 2013 22:22, ludo@gnu.org (Ludovic Court=C3=A8s) writes: > >> Andy Wingo skribis: >> >>> I find myself writing (read-delimited "" p) to slurp in a file as a >>> string, but it's not a very straightforward way to say that. >>> >>> What about `read-all'? We could add it to `(ice-9 rdelim)', I guess. >>> R6RS calls this `read-string-all'. >> >> Sounds like a good idea. > > Patch attached. I didn't update the docs because it wasn't clear to me > that (ice-9 rdelim) is actually the right place to put it. > > What do you think? Should we perhaps put it in a new (ice-9 ports)? > Are the names right? > > I started by writing it in C but I noticed the C was doing a very stupid > get-and-set algorithm, so I figured it got no advantage and we should > just write it in Scheme from the get-go. > > Andy --=-=-= Content-Type: text/x-diff; charset=utf-8 Content-Disposition: inline; filename=0001-add-read-all-and-read-all-to-ice-9-rdelim.patch Content-Transfer-Encoding: quoted-printable >From 056c69dee301f346d172293b71dfdc66ddfa0282 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 22 Jan 2013 10:12:59 +0100 Subject: [PATCH] add read-all and read-all! to (ice-9 rdelim) * module/ice-9/rdelim.scm (read-all!, read-all): New functions. * test-suite/tests/rdelim.test: Add tests. --- module/ice-9/rdelim.scm | 52 +++++++++++++++++++++++++++++++++++++- test-suite/tests/rdelim.test | 57 ++++++++++++++++++++++++++++++++++++++= ++-- 2 files changed, 106 insertions(+), 3 deletions(-) diff --git a/module/ice-9/rdelim.scm b/module/ice-9/rdelim.scm index c6ab2ba..9938942 100644 --- a/module/ice-9/rdelim.scm +++ b/module/ice-9/rdelim.scm @@ -1,6 +1,6 @@ ;;; installed-scm-file =20 -;;;; Copyright (C) 1997, 1999, 2000, 2001, 2006, 2010 Free Software Founda= tion, Inc. +;;;; Copyright (C) 1997, 1999, 2000, 2001, 2006, 2010, 2013 Free Software = Foundation, Inc. ;;;;=20 ;;;; 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-all + read-all! %read-delimited! %read-line write-line)) @@ -114,6 +116,54 @@ (else (error "unexpected handle-delim value: " handle-delim))))))))) =20 +(define-syntax-rule (check-arg arg exp message) + (unless exp + (error message arg))) + +(define (index? n) + (and (integer? n) (exact? n) (>=3D n 0))) + +(define* (read-all! 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 buf (string? buf) "not a string") + (check-arg start (index? start) "bad index") + (check-arg end (index? end) "bad index") + (check-arg start (<=3D start end) "start beyond end") + (check-arg end (<=3D end (string-length buf)) "end beyond string length") + (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-all #:optional (port (current-input-port))) + "Read all of the characters out of PORT and return them as a string." + (let loop ((substrings '()) + (total-chars 0) + (buf-size 100)) ; doubled each time through. + (let* ((buf (make-string buf-size)) + (nchars (read-all! buf port)) + (new-total (+ total-chars nchars))) + (cond + ((=3D 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/test-suite/tests/rdelim.test b/test-suite/tests/rdelim.test index e61fc92..a102df6 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=C3=A8s ;;;; -;;;; 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 @@ =20 (pass-if "eof, split" (eof-object? (read-delimited! ":" (make-string 7) - (open-input-string "")))))) + (open-input-string ""))))) + + (with-test-prefix "read-all" + + (pass-if "short string" + (let* ((s "hello, world!") + (p (open-input-string s))) + (and (string=3D? (read-all p) s) + (string=3D? (read-all p) "")))) + + (pass-if "100 chars" + (let* ((s (make-string 100 #\space)) + (p (open-input-string s))) + (and (string=3D? (read-all p) s) + (string=3D? (read-all p) "")))) + + (pass-if "longer than 100 chars" + (let* ((s (string-concatenate (make-list 20 "hello, world!"))) + (p (open-input-string s))) + (and (string=3D? (read-all p) s) + (string=3D? (read-all p) ""))))) + + (with-test-prefix "read-all!" + + (pass-if "buf smaller" + (let* ((s "hello, world!") + (len (1- (string-length s))) + (buf (make-string len #\.)) + (p (open-input-string s))) + (and (=3D (read-all! buf p) len) + (string=3D? buf (substring s 0 len)) + (=3D (read-all! buf p) 1) + (string=3D? (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 (=3D (read-all! buf p) len) + (string=3D? buf (substring s 0 len)) + (=3D (read-all! buf p) 0) + (string=3D? 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 (=3D (read-all! buf p) len) + (string=3D? (substring buf 0 len) s) + (=3D (read-all! buf p) 0) + (string=3D? (substring buf 0 len) s) + (string=3D? (substring buf len) ".")))))) =20 ;;; Local Variables: ;;; eval: (put 'with-test-prefix 'scheme-indent-function 1) --=20 1.7.10.4 --=-=-= Content-Type: text/plain -- http://wingolog.org/ --=-=-=--