~ 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 accessorsTrap