~ 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