>From 0a08ca5e5e581b60e53477f5c0ede454b9c8c663 Mon Sep 17 00:00:00 2001 From: Evan Hanson Date: Sun, 18 May 2014 14:16:31 +1200 Subject: [PATCH] Bound read-u8vector! to dest vector's size when no length is given Fixes #1124. --- srfi-4.scm | 12 ++++++------ tests/srfi-4-tests.scm | 12 ++++++++++++ 2 files changed, 18 insertions(+), 6 deletions(-) diff --git a/srfi-4.scm b/srfi-4.scm index 07ef84b..b1fea14 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 4e87a75..1d0a1b5 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)))) -- 1.7.10.4