~ chicken-core (chicken-5) 1d06ce7e21c7e903ca5dca11fda6fcf2cc52de5e

commit 1d06ce7e21c7e903ca5dca11fda6fcf2cc52de5e
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Sun May 18 14:16:31 2014 +1200
Commit:     Christian Kellermann <ckeen@pestilenz.org>
CommitDate: Sun May 18 10:41:09 2014 +0200

    Bound read-u8vector! to dest vector's size when no length is given
    
    Fixes #1124.
    
    Signed-off-by: Christian Kellermann <ckeen@pestilenz.org>

diff --git a/srfi-4.scm b/srfi-4.scm
index 07ef84b1..b1fea14a 100644
--- a/srfi-4.scm
+++ b/srfi-4.scm
@@ -653,12 +653,12 @@ EOF
   (##sys#check-input-port port #t 'read-u8vector!)
   (##sys#check-exact start 'read-u8vector!)
   (##sys#check-structure dest 'u8vector 'read-u8vector!)
-  (let ((dest (##sys#slot dest 1)))
-    (when n
-      (##sys#check-exact n 'read-u8vector!)
-      (when (fx> (fx+ start n) (##sys#size dest))
-	(set! n (fx- (##sys#size dest) start))))
-    (##sys#read-string! n dest port start) ) )
+  (when n (##sys#check-exact n 'read-u8vector!))
+  (let* ((dest (##sys#slot dest 1))
+	 (size (##sys#size dest)))
+    (unless (and n (fx<= (fx+ start n) size))
+      (set! n (fx- size start)))
+    (##sys#read-string! n dest port start)))
 
 (define read-u8vector
   (let ()
diff --git a/tests/srfi-4-tests.scm b/tests/srfi-4-tests.scm
index 4e87a759..1d0a1b57 100644
--- a/tests/srfi-4-tests.scm
+++ b/tests/srfi-4-tests.scm
@@ -42,3 +42,15 @@
 (assert (equal? #s32(-1 2 3) '#s32(-1 2 3)))
 (assert (equal? #f32(1 2 3) '#f32(1 2 3)))
 (assert (equal? #f64(-1 2 3) '#f64(-1 2 3)))
+
+;; Ticket #1124: read-u8vector! w/o length, dest smaller than source.
+(let ((input (open-input-string "abcdefghijklmnopqrstuvwxyz"))
+      (u8vec (make-u8vector 10)))
+  (assert (= 10 (read-u8vector! #f u8vec input)))
+  (assert (equal? u8vec #u8(97 98 99 100 101 102 103 104 105 106)))
+  (assert (= 5  (read-u8vector! #f u8vec input 5)))
+  (assert (equal? u8vec #u8(97 98 99 100 101 107 108 109 110 111)))
+  (assert (= 5  (read-u8vector! 5  u8vec input)))
+  (assert (equal? u8vec #u8(112 113 114 115 116 107 108 109 110 111)))
+  (assert (= 6  (read-u8vector! 10 u8vec input)))
+  (assert (equal? u8vec #u8(117 118 119 120 121 122 108 109 110 111))))