From dce9723600aaf62714a5f1d523640266839e94bf Mon Sep 17 00:00:00 2001
From: Jan Moringen <jmoringe@techfak.uni-bielefeld.de>
Date: Mon, 18 Jun 2012 19:28:18 +0200
Subject: [PATCH] add READ-STREAM-CONTENT-INTO-{STRING,BYTE-VECTOR}

  export and document them

  use them in READ-FILE-INTO-{STRING,BYTE-VECTOR}

  no smoke test for READ-STREAM-CONTENT-INTO-BYTE-VECTOR due to lack of
  something like WITH-INPUT-FROM-BYTE-VECTOR
---
 doc/alexandria.texinfo |  2 ++
 io.lisp                | 47 +++++++++++++++++++++++++++----------
 package.lisp           |  2 ++
 tests.lisp             | 53 ++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 92 insertions(+), 12 deletions(-)

diff --git a/doc/alexandria.texinfo b/doc/alexandria.texinfo
index 4468b0e..89b03ac 100644
--- a/doc/alexandria.texinfo
+++ b/doc/alexandria.texinfo
@@ -209,7 +209,9 @@ terms and conditions:
 @comment  node-name,   next,  previous,  up
 @chapter IO
 
+@include include/fun-alexandria-read-stream-content-into-string.texinfo
 @include include/fun-alexandria-read-file-into-string.texinfo
+@include include/fun-alexandria-read-stream-content-into-byte-vector.texinfo
 @include include/fun-alexandria-read-file-into-byte-vector.texinfo
 
 @node Macro Writing
diff --git a/io.lisp b/io.lisp
index 52551c7..f36dd66 100644
--- a/io.lisp
+++ b/io.lisp
@@ -50,6 +50,17 @@ which is only sent to WITH-OPEN-FILE when it's not NIL."
   `(with-open-file* (,stream-name ,file-name :direction :output ,@args)
      ,@body))
 
+(defun read-stream-content-into-string (stream &key (buffer-size 4096))
+  "Return the \"content\" of STREAM as a fresh string."
+  (check-type buffer-size positive-integer)
+  (let ((*print-pretty* nil))
+    (with-output-to-string (datum)
+      (let ((buffer (make-array buffer-size :element-type 'character)))
+        (loop
+          :for bytes-read = (read-sequence buffer stream)
+          :do (write-sequence buffer datum :start 0 :end bytes-read)
+          :while (= bytes-read buffer-size))))))
+
 (defun read-file-into-string (pathname &key (buffer-size 4096) external-format)
   "Return the contents of the file denoted by PATHNAME as a fresh string.
 
@@ -57,13 +68,7 @@ The EXTERNAL-FORMAT parameter will be passed directly to WITH-OPEN-FILE
 unless it's NIL, which means the system default."
   (with-input-from-file
       (file-stream pathname :external-format external-format)
-    (let ((*print-pretty* nil))
-      (with-output-to-string (datum)
-        (let ((buffer (make-array buffer-size :element-type 'character)))
-	  (loop
-	     :for bytes-read = (read-sequence buffer file-stream)
-	     :do (write-sequence buffer datum :start 0 :end bytes-read)
-	     :while (= bytes-read buffer-size)))))))
+    (read-stream-content-into-string file-stream :buffer-size buffer-size)))
 
 (defun write-string-into-file (string pathname &key (if-exists :error)
                                                     if-does-not-exist
@@ -77,14 +82,32 @@ unless it's NIL, which means the system default."
                                     :external-format external-format)
     (write-sequence string file-stream)))
 
+(defun read-stream-content-into-byte-vector (stream &key ((%length length))
+                                                         (initial-size 4096))
+  "Return \"content\" of STREAM as freshly allocated (unsigned-byte 8) vector."
+  (check-type length (or null non-negative-integer))
+  (check-type initial-size positive-integer)
+  (do ((buffer (make-array (or length initial-size)
+                           :element-type '(unsigned-byte 8)))
+       (offset 0)
+       (offset-wanted 0))
+      ((or (/= offset-wanted offset)
+           (and length (>= offset length)))
+       (if (= offset (length buffer))
+           buffer
+           (subseq buffer 0 offset)))
+    (unless (zerop offset)
+      (let ((new-buffer (make-array (* 2 (length buffer))
+                                    :element-type '(unsigned-byte 8))))
+        (replace new-buffer buffer)
+        (setf buffer new-buffer)))
+    (setf offset-wanted (length buffer)
+          offset (read-sequence buffer stream :start offset))))
+
 (defun read-file-into-byte-vector (pathname)
   "Read PATHNAME into a freshly allocated (unsigned-byte 8) vector."
   (with-input-from-file (stream pathname :element-type '(unsigned-byte 8))
-    (let ((length (file-length stream)))
-      (assert length)
-      (let ((result (make-array length :element-type '(unsigned-byte 8))))
-        (read-sequence result stream)
-        result))))
+    (read-stream-content-into-byte-vector stream '%length (file-length stream))))
 
 (defun write-byte-vector-into-file (bytes pathname &key (if-exists :error)
                                                        if-does-not-exist)
diff --git a/package.lisp b/package.lisp
index cf258fc..180e7e9 100644
--- a/package.lisp
+++ b/package.lisp
@@ -226,8 +226,10 @@
    ;; io
    #:with-input-from-file
    #:with-output-to-file
+   #:read-stream-content-into-string
    #:read-file-into-string
    #:write-string-into-file
+   #:read-stream-content-into-byte-vector
    #:read-file-into-byte-vector
    #:write-byte-vector-into-file
    #:copy-stream
diff --git a/tests.lisp b/tests.lisp
index a3fe840..f3cb055 100644
--- a/tests.lisp
+++ b/tests.lisp
@@ -1511,6 +1511,59 @@
                                  dotted-list nth)))))))))
   nil)
 
+;;;; IO
+
+(deftest read-stream-content-into-string.1
+    (values (with-input-from-string (stream "foo bar")
+              (read-stream-content-into-string stream))
+            (with-input-from-string (stream "foo bar")
+              (read-stream-content-into-string stream :buffer-size 1))
+            (with-input-from-string (stream "foo bar")
+              (read-stream-content-into-string stream :buffer-size 6))
+            (with-input-from-string (stream "foo bar")
+              (read-stream-content-into-string stream :buffer-size 7)))
+  "foo bar"
+  "foo bar"
+  "foo bar"
+  "foo bar")
+
+(deftest read-stream-content-into-string.2
+    (handler-case
+        (let ((stream (make-broadcast-stream)))
+          (read-stream-content-into-string stream :buffer-size 0))
+      (type-error ()
+        :type-error))
+  :type-error)
+
+#+(or)
+(defvar *octets*
+  (map '(simple-array (unsigned-byte 8) (7)) #'char-code "foo bar"))
+
+#+(or)
+(deftest read-stream-content-into-byte-vector.1
+    (values (with-input-from-byte-vector (stream *octets*)
+              (read-stream-content-into-byte-vector stream))
+            (with-input-from-byte-vector (stream *octets*)
+              (read-stream-content-into-byte-vector stream :initial-size 1))
+            (with-input-from-byte-vector (stream *octets*)
+              (read-stream-content-into-byte-vector stream 'alexandria::%length 6))
+            (with-input-from-byte-vector (stream *octets*)
+              (read-stream-content-into-byte-vector stream 'alexandria::%length 3)))
+  *octets*
+  *octets*
+  *octets*
+  (subseq *octets* 0 3))
+
+(deftest read-stream-content-into-byte-vector.2
+    (handler-case
+        (let ((stream (make-broadcast-stream)))
+          (read-stream-content-into-byte-vector stream :initial-size 0))
+      (type-error ()
+        :type-error))
+  :type-error)
+
+;;;; Macros
+
 (deftest with-unique-names.1
     (let ((*gensym-counter* 0))
       (let ((syms (with-unique-names (foo bar quux)
-- 
GitLab