[alexandria.git] updated branch master: 4955542 copy-stream: fix non-standard loops

Nikodemus Siivola nsiivola at common-lisp.net
Fri Mar 30 15:23:11 UTC 2012


The branch master has been updated:
       via  49555427d8019a56132def9a4440663c66339131 (commit)
      from  209c6e29adf83292745092200279847daa99a18d (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 49555427d8019a56132def9a4440663c66339131
Author: Nikodemus Siivola <nikodemus at random-state.net>
Date:   Fri Mar 30 18:22:47 2012 +0300

    copy-stream: fix non-standard loops
    
      Added test-case.

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

Summary of changes:
 io.lisp    |   45 +++++++++++++++++++++------------------------
 tests.lisp |   23 +++++++++++++++++++++++
 2 files changed, 44 insertions(+), 24 deletions(-)

diff --git a/io.lisp b/io.lisp
index ee89cb0..52551c7 100644
--- a/io.lisp
+++ b/io.lisp
@@ -122,31 +122,28 @@ compatible element-types."
         (input-position 0))
     (unless (zerop start)
       ;; FIXME add platform specific optimization to skip seekable streams
-      (loop
-        :while (< input-position start)
-        :for bytes-read = (read-sequence buffer input
-                                         :end (min (length buffer)
-                                                   (- start input-position)))
-        :do (progn
-              (when (zerop bytes-read)
-                (error "Could not read enough bytes from the input to fulfill the START requirement in ~S" 'copy-stream))
-              (incf input-position bytes-read))))
+      (loop while (< input-position start)
+            do (let ((n (read-sequence buffer input
+                                       :end (min (length buffer)
+                                                 (- start input-position)))))
+                 (when (zerop n)
+                   (error "~@<Could not read enough bytes from the input to fulfill ~
+                           the :START ~S requirement in ~S.~:@>" 'copy-stream start))
+                 (incf input-position n))))
     (assert (= input-position start))
-    (loop
-      :while (or (null end)
-                 (< input-position end))
-      :for bytes-read = (read-sequence buffer input
-                                       :end (when end
-                                              (min (length buffer)
-                                                   (- end input-position))))
-      :do (progn
-            (when (zerop bytes-read)
-              (if end
-                  (error "Could not read enough bytes from the input to fulfill the END requirement in ~S" 'copy-stream)
-                  (return)))
-            (incf input-position bytes-read)
-            (write-sequence buffer output :end bytes-read)
-            (incf output-position bytes-read)))
+    (loop while (or (null end) (< input-position end))
+          do (let ((n (read-sequence buffer input
+                                     :end (when end
+                                            (min (length buffer)
+                                                 (- end input-position))))))
+               (when (zerop n)
+                 (if end
+                     (error "~@<Could not read enough bytes from the input to fulfill ~
+                          the :END ~S requirement in ~S.~:@>" 'copy-stream end)
+                     (return)))
+               (incf input-position n)
+               (write-sequence buffer output :end n)
+               (incf output-position n)))
     (when finish-output
       (finish-output output))
     output-position))
diff --git a/tests.lisp b/tests.lisp
index bd2725f..b875382 100644
--- a/tests.lisp
+++ b/tests.lisp
@@ -1807,3 +1807,26 @@
 (deftest binomial-coefficient.1
     (alexandria:binomial-coefficient 1239 139)
   28794902202288970200771694600561826718847179309929858835480006683522184441358211423695124921058123706380656375919763349913245306834194782172712255592710204598527867804110129489943080460154)
+
+(deftest copy-stream.1
+    (let ((data "sdkfjhsakfh weior763495ewofhsdfk sdfadlkfjhsadf woif sdlkjfhslkdfh sdklfjh"))
+      (values (equal data
+                     (with-input-from-string (in data)
+                       (with-output-to-string (out)
+                         (alexandria:copy-stream in out))))
+              (equal (subseq data 10 20)
+                     (with-input-from-string (in data)
+                       (with-output-to-string (out)
+                         (alexandria:copy-stream in out :start 10 :end 20))))
+              (equal (subseq data 10)
+                     (with-input-from-string (in data)
+                       (with-output-to-string (out)
+                         (alexandria:copy-stream in out :start 10))))
+              (equal (subseq data 0 20)
+                     (with-input-from-string (in data)
+                       (with-output-to-string (out)
+                         (alexandria:copy-stream in out :end 20))))))
+  t
+  t
+  t
+  t)
-- 
Alexandria hooks/post-receive




More information about the alexandria-cvs mailing list