diff --git a/benchmark-suite/benchmarks/ports.bm b/benchmark-suite/benchmarks/ports.bm index 630ece290..f4da2609a 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/module/ice-9/rdelim.scm b/module/ice-9/rdelim.scm index 32908cc4a..a406f4e55 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/rdelim.test b/test-suite/tests/rdelim.test index 5cfe6460d..9083b7f62 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 ;;;; -;;;; 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!"