# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1529280627 25200
# Node ID 7db631c1cf60d895bb720268f7d3fd2aa6510729
# Parent  a0c69729ade3e0f6ce9faed36f11e1d093e3ba8f
Add array tests

diff -r a0c69729ade3 -r 7db631c1cf60 losh.asd
--- a/losh.asd	Sun Jun 17 16:50:40 2018 -0700
+++ b/losh.asd	Sun Jun 17 17:10:27 2018 -0700
@@ -73,6 +73,7 @@
                 :serial t
                 :components ((:file "package")
                              (:file "base")
+                             (:file "arrays")
                              (:file "control-flow"))))
 
   :perform (asdf:test-op (op system)
diff -r a0c69729ade3 -r 7db631c1cf60 src/arrays.lisp
--- a/src/arrays.lisp	Sun Jun 17 16:50:40 2018 -0700
+++ b/src/arrays.lisp	Sun Jun 17 17:10:27 2018 -0700
@@ -1,7 +1,5 @@
 (in-package :losh.arrays)
 
-
-;;;; Arrays -------------------------------------------------------------------
 (declaim
   (ftype (function ((array * *) t)) fill-multidimensional-array)
   (ftype (function ((array t *) t)) fill-multidimensional-array-t)
diff -r a0c69729ade3 -r 7db631c1cf60 test/arrays.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/test/arrays.lisp	Sun Jun 17 17:10:27 2018 -0700
@@ -0,0 +1,77 @@
+(in-package :losh.test)
+
+
+(define-test do-array
+  (let ((a (make-array 4 :initial-contents '(1 2 3 4)))
+        (mda (make-array (list 2 2) :initial-contents '((1 2) (3 4)))))
+    (is (equal '(1 2 3 4)
+               (gathering
+                 (do-array (x a)
+                   (gather x)))))
+    (do-array (x mda)
+      (incf x))
+    (is (equal '(2 3 4 5)
+               (gathering
+                 (do-array (x mda)
+                   (gather x)))))))
+
+(define-test fill-multidimensional-array
+  (let ((mda (make-array (list 2 2) :initial-contents '((1 2) (3 4)))))
+    (is (equalp #2A((1 2) (3 4)) mda))
+    (fill-multidimensional-array mda 9)
+    (is (equalp #2A((9 9) (9 9)) mda)))
+
+  (let ((mda (make-array (list 2 2)
+               :initial-contents '((1 2) (3 4))
+               :element-type t)))
+    (is (equalp #2A((1 2) (3 4)) mda))
+    (fill-multidimensional-array-t mda 9)
+    (is (equalp #2A((9 9) (9 9)) mda)))
+
+  (let ((mda (make-array (list 2 2)
+               :initial-contents '((1 2) (3 4))
+               :element-type 'fixnum)))
+    (is (equalp #2A((1 2) (3 4)) mda))
+    (fill-multidimensional-array-fixnum mda 9)
+    (is (equalp #2A((9 9) (9 9)) mda)))
+
+  (let ((mda (make-array (list 2 2)
+               :initial-contents '((1.0 2.0) (3.0 4.0))
+               :element-type 'single-float)))
+    (is (equalp #2A((1.0 2.0) (3.0 4.0)) mda))
+    (fill-multidimensional-array-single-float mda 9.0)
+    (is (equalp #2A((9.0 9.0) (9.0 9.0)) mda))))
+
+(define-test vector-last
+  (is (equal '(nil nil)
+             (multiple-value-list (vector-last #()))))
+  (is (equal '(nil t)
+             (multiple-value-list (vector-last #(nil)))))
+  (let ((v (make-array 4
+             :initial-contents '(1 2 3 4)
+             :fill-pointer t)))
+    (is (equal '(4 t)
+               (multiple-value-list (vector-last v))))
+    (setf (fill-pointer v) 2)
+    (is (equal '(2 t)
+               (multiple-value-list (vector-last v))))
+    (setf (fill-pointer v) 0)
+    (is (equal '(nil nil)
+               (multiple-value-list (vector-last v))))))
+
+
+(define-test bisect-left
+  (let ((v #(10 12 14 16 18 20)))
+    (is (equal '(14 2) (multiple-value-list (bisect-left #'<= v 15))))
+    (is (equal '(14 2) (multiple-value-list (bisect-left #'<= v 14))))
+    (is (equal '(20 5) (multiple-value-list (bisect-left #'<= v 999))))
+    (is (equal '(10 0) (multiple-value-list (bisect-left #'<= v 11))))
+    (is (equal '(nil nil) (multiple-value-list (bisect-left #'<= v 0))))))
+
+(define-test bisect-right
+  (let ((v #(10 12 14 16 18 20)))
+    (is (equal '(16 3) (multiple-value-list (bisect-right #'<= v 15))))
+    (is (equal '(16 3) (multiple-value-list (bisect-right #'<= v 14))))
+    (is (equal '(nil nil) (multiple-value-list (bisect-right #'<= v 999))))
+    (is (equal '(12 1) (multiple-value-list (bisect-right #'<= v 11))))
+    (is (equal '(10 0) (multiple-value-list (bisect-right #'<= v 0))))))