See commit message for details
>From f08fc812501e9d2e5ee7e3b2154642255bedaa66 Mon Sep 17 00:00:00 2001
From: Moritz Heidkamp <mor...@twoticketsplease.de>
Date: Wed, 2 Jan 2013 22:02:10 +0100
Subject: [PATCH] Fix TO argument check in subvector procedure

The subvector procedure checked its TO argument as if it was
inclusive. However, its default value is the passed vector's length so
it must be exclusive which also corresponds with the implementation. In
effect, the erroneous check prevented producing a subvector including
the given vector's last element. This patch changes the TO argument
check to be exclusive and adds some test cases for the subvector
procedure.
---
 library.scm             | 2 +-
 tests/library-tests.scm | 8 +++++++-
 2 files changed, 8 insertions(+), 2 deletions(-)

diff --git a/library.scm b/library.scm
index 5ed1e24..46cfe49 100644
--- a/library.scm
+++ b/library.scm
@@ -1391,7 +1391,7 @@ EOF
 	 (j (or j len))
 	 (len2 (fx- j i)))
     (##sys#check-range i 0 len 'subvector)
-    (##sys#check-range j 0 len 'subvector)
+    (##sys#check-range j 0 (fx+ len 1) 'subvector)
     (let ((v2 (make-vector len2)))
       (do ((k 0 (fx+ k 1)))
 	  ((fx>= k len2) v2)
diff --git a/tests/library-tests.scm b/tests/library-tests.scm
index c385c1b..2d88321 100644
--- a/tests/library-tests.scm
+++ b/tests/library-tests.scm
@@ -420,4 +420,10 @@
 
 ;;; message checks for invalid strings
 
-(assert-fail (##sys#message "123\x00456"))
\ No newline at end of file
+(assert-fail (##sys#message "123\x00456"))
+
+;;; vector procedures
+
+(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)))
-- 
1.8.0.2

_______________________________________________
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers

Reply via email to