~ chicken-core (chicken-5) 226007b282865d23b67db0ffa92a8b790032efdc


commit 226007b282865d23b67db0ffa92a8b790032efdc
Author:     Mario Domenech Goulart <mario.goulart@gmail.com>
AuthorDate: Thu Feb 6 09:01:02 2014 -0200
Commit:     Peter Bex <peter.bex@xs4all.nl>
CommitDate: Thu Feb 6 19:36:08 2014 +0100

    Fix subvector when the TO optional argument equals the given vector length (#1097)
    
    Signed-off-by: Peter Bex <peter.bex@xs4all.nl>

diff --git a/NEWS b/NEWS
index 13b34879..e556e3ee 100644
--- a/NEWS
+++ b/NEWS
@@ -4,6 +4,10 @@
   - csc "-deploy" works now on FreeBSD (thanks to Jules Altfas and
     Vitaly Magerya), OpenBSD and NetBSD (see README for NetBSD).
 
+- Core libraries
+  - Fix subvector when the TO optional argument equals the given vector
+    length (#1097)
+
 4.8.3
 
 - Security fixes
diff --git a/library.scm b/library.scm
index 6194e537..31eda652 100644
--- a/library.scm
+++ b/library.scm
@@ -1408,7 +1408,7 @@ EOF
   (let* ((len (##sys#size v))
 	 (j (or j len))
 	 (len2 (fx- j i)))
-    (##sys#check-range i 0 len 'subvector)
+    (##sys#check-range i 0 (fx+ len 1) 'subvector)
     (##sys#check-range j 0 (fx+ len 1) 'subvector)
     (let ((v2 (make-vector len2)))
       (do ((k 0 (fx+ k 1)))
diff --git a/tests/library-tests.scm b/tests/library-tests.scm
index df0639f0..6638a59a 100644
--- a/tests/library-tests.scm
+++ b/tests/library-tests.scm
@@ -541,6 +541,9 @@ A
 (assert (equal? '#(2 3) (subvector '#(1 2 3) 1)))
 (assert (equal? '#(2)   (subvector '#(1 2 3) 1 2)))
 (assert (equal? '#()    (subvector '#(1 2 3) 1 1)))
+(assert (equal? '#()    (subvector '#(1 2 3) 3)))
+(assert-fail (subvector '#(1 2 3) 4))
+(assert-fail (subvector '#(1 2 3) 3 4))
 
 ;;; alist accessors
 
Trap