[alexandria.git] updated branch master: 77b219a SHUFFLE on non-lists did not respect :START and :END

[Nikodemus Siivola]

The branch master has been updated:
       via  77b219a8361b9549aeb8941afc945fa2e3c84eb9 (commit)
      from  c1644dfb6b0d8c74751ff080265e0e436e83c64b (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 77b219a8361b9549aeb8941afc945fa2e3c84eb9
Author: Jianshi Huang <jianshi.huang at gmail.com>
Date:   Wed Nov 9 14:56:58 2011 +0200

    SHUFFLE on non-lists did not respect :START and :END

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

Summary of changes:
 sequences.lisp |   13 ++++++++-----
 tests.lisp     |    8 ++++++++
 2 files changed, 16 insertions(+), 5 deletions(-)

diff --git a/sequences.lisp b/sequences.lisp
index f1e3f50..e7f1925 100644
--- a/sequences.lisp
+++ b/sequences.lisp
@@ -83,8 +83,9 @@ share structure with it."
   "Returns a random permutation of SEQUENCE bounded by START and END.
 Permuted sequence may share storage with the original one. Signals an
 error if SEQUENCE is not a proper sequence."
-  (declare (fixnum start) (type (or fixnum null) end))
-  (typecase sequence
+  (declare (type fixnum start)
+           (type (or fixnum null) end))
+  (etypecase sequence
     (list
      (let* ((end (or end (proper-list-length sequence)))
             (n (- end start)))
@@ -94,12 +95,14 @@ error if SEQUENCE is not a proper sequence."
          (decf n))))
     (vector
      (let ((end (or end (length sequence))))
-       (loop for i from (- end 1) downto start
-             do (rotatef (aref sequence i) (aref sequence (random (+ i 1)))))))
+       (loop for i from start below end
+             do (rotatef (aref sequence i)
+                         (aref sequence (+ i (random (- end i))))))))
     (sequence
      (let ((end (or end (length sequence))))
        (loop for i from (- end 1) downto start
-             do (rotatef (elt sequence i) (elt sequence (random (+ i 1))))))))
+             do (rotatef (elt sequence i)
+                         (elt sequence (+ i (random (- end i)))))))))
   sequence)
 
 (defun random-elt (sequence &key (start 0) end)
diff --git a/tests.lisp b/tests.lisp
index 20caf8a..babe0f4 100644
--- a/tests.lisp
+++ b/tests.lisp
@@ -1128,6 +1128,14 @@
                    s)))
   (nil t t))
 
+(deftest shuffle.3
+    (let* ((orig (coerce (iota 21) 'vector))
+           (copy (copy-seq orig)))
+      (shuffle copy :start 10 :end 15)
+      (list (every #'eql (subseq copy 0 10) (subseq orig 0 10))
+            (every #'eql (subseq copy 15) (subseq orig 15))))
+  (t t))
+
 (deftest random-elt.1
     (let ((s1 #(1 2 3 4))
           (s2 '(1 2 3 4)))
-- 
Alexandria hooks/post-receive