[Guile-commits] GNU Guile branch, master, updated. release_1-9-11-235-g551b96d

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=551b96d294f3b09c37124562e3da64a7bd399666

The branch, master has been updated
       via  551b96d294f3b09c37124562e3da64a7bd399666 (commit)
      from  f9560a348e83ec3c494aee0d42b056383392ffca (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 551b96d294f3b09c37124562e3da64a7bd399666
Author: Andy Wingo <address@hidden>
Date:   Wed Aug 4 21:48:00 2010 +0200

    fix vector-move-right! and vector-move-left!
    
    * libguile/vectors.c (scm_vector_move_left_x, scm_vector_move_right_x):
      Fix some bugs reported by Michael Lucy -- both variants would happily
      write beyond the end, and vector-move-right! didn't increment the
      counter before copying in the reverse direction.
    
    * test-suite/tests/vectors.test ("vector-move-left!"):
      ("vector-move-right!"): Add tests.

-----------------------------------------------------------------------

Summary of changes:
 libguile/vectors.c            |   10 ++++-
 test-suite/tests/vectors.test |   81 ++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 88 insertions(+), 3 deletions(-)

diff --git a/libguile/vectors.c b/libguile/vectors.c
index 321b499..f9b4fc2 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -533,7 +533,9 @@ SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!", 5, 
0, 0,
 
   i = scm_to_unsigned_integer (start1, 0, len1);
   e = scm_to_unsigned_integer (end1, i, len1);
-  j = scm_to_unsigned_integer (start2, 0, len2 - (i-e));
+  SCM_ASSERT_RANGE (SCM_ARG3, end1, (e-i) < len2);
+  j = scm_to_unsigned_integer (start2, 0, len2);
+  SCM_ASSERT_RANGE (SCM_ARG5, start2, j <= len2 - (e - i));
   
   i *= inc1;
   e *= inc1;
@@ -571,7 +573,11 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 
5, 0, 0,
 
   i = scm_to_unsigned_integer (start1, 0, len1);
   e = scm_to_unsigned_integer (end1, i, len1);
-  j = scm_to_unsigned_integer (start2, 0, len2 - (i-e));
+  SCM_ASSERT_RANGE (SCM_ARG3, end1, (e-i) < len2);
+  j = scm_to_unsigned_integer (start2, 0, len2);
+  SCM_ASSERT_RANGE (SCM_ARG5, start2, j <= len2 - (e - i));
+  
+  j += (e - i);
   
   i *= inc1;
   e *= inc1;
diff --git a/test-suite/tests/vectors.test b/test-suite/tests/vectors.test
index fe85625..f4df7de 100644
--- a/test-suite/tests/vectors.test
+++ b/test-suite/tests/vectors.test
@@ -1,6 +1,6 @@
 ;;;; vectors.test --- test suite for Guile's vector functions -*- scheme -*-
 ;;;;
-;;;; Copyright (C) 2003, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 2003, 2006, 2010 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -62,3 +62,82 @@
     (equal? #("ab\u0100" "ab\u0100" "ab\u0100") 
             (make-vector 3 "ab\u0100"))))
 
+(with-test-prefix "vector-move-left!"
+
+  (pass-if-exception "before start" exception:out-of-range
+    (let ((a (vector 1 2 3 4 5 6 7 8 9))
+          (b (vector 10 20 30 40 50 60 70 80 90)))
+      (vector-move-left! a 3 5 b -1)))
+
+  (pass-if "beginning"
+    (let ((a (vector 1 2 3 4 5 6 7 8 9))
+          (b (vector 10 20 30 40 50 60 70 80 90)))
+      (vector-move-left! a 3 5 b 0)
+      (equal? b #(4 5 30 40 50 60 70 80 90))))
+
+  (pass-if "middle"
+    (let ((a (vector 1 2 3 4 5 6 7 8 9))
+          (b (vector 10 20 30 40 50 60 70 80 90)))
+      (vector-move-left! a 3 5 b 2)
+      (equal? b #(10 20 4 5 50 60 70 80 90))))
+
+  (pass-if "overlap -"
+    (let ((a (vector 1 2 3 4 5 6 7 8 9)))
+      (vector-move-left! a 3 5 a 2)
+      (equal? a #(1 2 4 5 5 6 7 8 9))))
+
+  (pass-if "overlap +"
+    (let ((a (vector 1 2 3 4 5 6 7 8 9)))
+      (vector-move-left! a 3 5 a 4)
+      (equal? a #(1 2 3 4 4 4 7 8 9))))
+
+  (pass-if "end"
+    (let ((a (vector 1 2 3 4 5 6 7 8 9))
+          (b (vector 10 20 30 40 50 60 70 80 90)))
+       (vector-move-left! a 3 5 b 7)
+       (equal? b #(10 20 30 40 50 60 70 4 5))))
+
+  (pass-if-exception "past end" exception:out-of-range
+    (let ((a (vector 1 2 3 4 5 6 7 8 9))
+          (b (vector 10 20 30 40 50 60 70 80 90)))
+      (vector-move-left! a 3 5 b 8))))
+
+(with-test-prefix "vector-move-right!"
+
+  (pass-if-exception "before start" exception:out-of-range
+    (let ((a (vector 1 2 3 4 5 6 7 8 9))
+          (b (vector 10 20 30 40 50 60 70 80 90)))
+      (vector-move-right! a 3 5 b -1)))
+
+  (pass-if "beginning"
+    (let ((a (vector 1 2 3 4 5 6 7 8 9))
+          (b (vector 10 20 30 40 50 60 70 80 90)))
+      (vector-move-right! a 3 5 b 0)
+      (equal? b #(4 5 30 40 50 60 70 80 90))))
+
+  (pass-if "middle"
+    (let ((a (vector 1 2 3 4 5 6 7 8 9))
+          (b (vector 10 20 30 40 50 60 70 80 90)))
+      (vector-move-right! a 3 5 b 2)
+      (equal? b #(10 20 4 5 50 60 70 80 90))))
+
+  (pass-if "overlap -"
+    (let ((a (vector 1 2 3 4 5 6 7 8 9)))
+      (vector-move-right! a 3 5 a 2)
+      (equal? a #(1 2 5 5 5 6 7 8 9))))
+
+  (pass-if "overlap +"
+    (let ((a (vector 1 2 3 4 5 6 7 8 9)))
+      (vector-move-right! a 3 5 a 4)
+      (equal? a #(1 2 3 4 4 5 7 8 9))))
+
+  (pass-if "end"
+    (let ((a (vector 1 2 3 4 5 6 7 8 9))
+          (b (vector 10 20 30 40 50 60 70 80 90)))
+       (vector-move-right! a 3 5 b 7)
+       (equal? b #(10 20 30 40 50 60 70 4 5))))
+
+  (pass-if-exception "past end" exception:out-of-range
+    (let ((a (vector 1 2 3 4 5 6 7 8 9))
+          (b (vector 10 20 30 40 50 60 70 80 90)))
+      (vector-move-right! a 3 5 b 8))))


hooks/post-receive
-- 
GNU Guile